試圖交叉工作表複製並粘貼到一張工作表中，使用不同的信息範圍

我有一張工作表，它允許選擇零件編號，並且所有經過的操作都被拉起，每個操作的步驟都已啓動不同的牀單。我試圖創建的是基於它將所有操作過程提取到一張紙上進行打印的操作。並非所有操作都具有相同的步驟數量，並且並非每個部件都具有相同的操作數量。試圖交叉工作表複製並粘貼到一張工作表中，使用不同的信息範圍

代碼我已經爲第一個操作和第二個操作的前3行工作。但我無法把它全部拿出來。以下是我正在使用的代碼。目前我只關注OP 1和2，一旦得到它必須能夠在大約30種選擇中選擇16種不同的OPS。

Dim rng As Range 

If Sheets("Selection").Range("D3").Text = "N/A" Then 
    Exit Sub 
Else 
    Set rng = Sheets(Sheets("Selection").Range("D3").Text).Range("A12:" & ActiveSheet.Range("S12").End(xlDown).Address) 
    With rng 
     .Copy 
    End With 
    With Sheets("Print FMEA").Range("S" & Rows.Count).End(xlUp).Offset(1, -18) 
    .PasteSpecial xlPasteFormats 
    .PasteSpecial xlPasteValues 
    End With 

End If 

If Sheets("Selection").Range("D4").Text = "N/A" Then 
    Exit Sub 
Else 
    Set rng = Sheets(Sheets("Selection").Range("D4").Text).Range("A12:" & ActiveSheet.Range("S12").End(xlDown).Address) 
    With rng 
     .Copy 
    End With 
    With Sheets("Print FMEA").Range("S" & Rows.Count).End(xlUp).Offset(1, -18) 
    .PasteSpecial xlPasteFormats 
    .PasteSpecial xlPasteValues 
    End With 

End If 

End Sub

來源

2015-11-02 Nicodemus

不確定你的意圖，但猜測你想要一個循環。 – findwindow

讓我們處理第一個錯誤：

這條線將拋出一個錯誤Sheets("Print FMEA").Row (Lastrow + 1)。我不確定你想用它做什麼，但是語法不正確。我有點驚訝，你說代碼已經爲你工作。

該行只會選擇數據到下一個空白單元格Set rng = Sheets(Sheets("Selection").Range("D4").Text).Range("A12:" & ActiveSheet.Range("S12").End(xlDown).Address)。你可能只得到前三行，因爲第四行有空白。

要回答你的問題，我認爲你需要分兩部分來看待這個問題：

存儲每個操作的參考信息。
循環執行每個操作並處理細節。

有很多方法可以做到這一點，但Class對象將工作正常。我舉了一個沒有最佳使用類的例子，但它確實區分了這兩個任務。

因此，對於第1部分，插入一個新類（Insert〜> Class Module）並將其命名爲OpsFields。將下面的代碼存儲在表和單元格引用：

Private mSourceSheet As Worksheet 
Private mRefSheet As Worksheet 
Private mRefFirstRange As Range 

Public Sub SetRefSheetAddress(sourceSheet As String, cellAddress As String) 
    Dim sheetName As String 

    Set mSourceSheet = ThisWorkbook.Worksheets(sourceSheet) 
    sheetName = mSourceSheet.Range(cellAddress) 
    Set mRefSheet = ThisWorkbook.Worksheets(sheetName) 
End Sub 

Public Sub SetFirstRefAddress(columnsAddress As String, firstRow As Long) 
    Set mRefFirstRange = Intersect(mRefSheet.Columns(columnsAddress), _ 
         mRefSheet.Rows(firstRow).EntireRow) 
End Sub 

Public Function GetDataRange() 
    Dim r As Long 
    Dim c As Long 
    Dim lastRow As Long 
    Dim rowCount As Long 

    r = mRefSheet.Rows.Count 
    c = mRefFirstRange.Columns(1).Column 
    lastRow = mRefSheet.Cells(r, c).End(xlUp).Row 
    rowCount = lastRow - mRefFirstRange.Rows(1).Row + 1 
    Set GetDataRange = mRefFirstRange.Resize(rowCount) 
End Function

您然後填充這些類並將它們存儲到某種形式的名單 - 我已經使用了Collection因爲你不必REDIMENSION，所以操作次數並不重要。在下面的代碼中，我給了你兩個例子，但你可以添加儘可能多的。此代碼將在你Module：

Private mOpsList As Collection 'at top of module 



Sub CreateOpsFields() 
    Dim ops As OpsFields 

    Set mOpsList = New Collection 

    Set ops = New OpsFields 
    ops.SetRefSheetAddress "Selection", "D3" 
    ops.SetFirstRefAddress "A:S", 12 
    mOpsList.Add ops 

    Set ops = New OpsFields 
    ops.SetRefSheetAddress "Selection", "D4" 
    ops.SetFirstRefAddress "A:S", 12 
    mOpsList.Add ops 

End Sub

至於第2部分，您只需通過你的課程列表循環和（在你的Module再次）執行粘貼任務，具體如下：

Sub RecordOps() 
    Dim outputSheet As Worksheet 
    Dim ops As OpsFields 
    Dim data As Range 
    Dim nextBlankRow As Long 

    Set outputSheet = ThisWorkbook.Worksheets("Print FMEA") 
    nextBlankRow = outputSheet.Cells(outputSheet.Rows.Count, "S").End(xlUp).Row 
    For Each ops In mOpsList 
     Set data = ops.GetDataRange 
     data.Copy 
     With outputSheet.Cells(nextBlankRow, "A").Resize(data.Rows.Count, data.Columns.Count) 
      .PasteSpecial xlPasteFormats 
      .PasteSpecial xlPasteValues 
     End With 
     nextBlankRow = nextBlankRow + data.Rows.Count 
    Next 
End Sub

你以正常的方式調用這些例程。一個顯而易見的方法是在某種初始化例程中填充類，然後在觸發某個事件時調用粘貼例程。我只是把兩個調用放在一個例程中，所以你可以看到語法：

Sub RunMe() 
    CreateOpsFields 
    RecordOps 
End Sub

來源

2015-11-03 01:21:11 Ambie

試圖交叉工作表複製並粘貼到一張工作表中，使用不同的信息範圍

回答

相關問題