使用組合框將數據從輸入表復制到 VBA 中的日志表

Question

我有一個實驗室工作簿，其中包含收集的實驗室數據。 該工作表有一個輸入頁面，其中包括以下輸入頁面。 輸入頁面有兩列，一列用於流入值，另一列用於流出值。

在輸入頁面上，Influent 以 B13 到 lRow 開頭，而 Effluent 以 C13 到 lRow 開頭。 輸入頁面有一個名為 cbSheet 的組合框，因此用戶可以選擇將此數據傳輸到哪個設施日志表。

我已經編寫了一個宏，它應該將輸入表中的 Influent 數據復制並轉置到組合框中選擇的表中，並將其粘貼到最后使用的行之后。 接下來，宏應該復制流出數據並將其直接粘貼到同一張表上流入數據的下方。 我希望宏交替復制流入轉置和粘貼到組合框中選擇的工作表，然后是流出。 所以你會在日志表上有這樣的東西：

Influent "DATA"   
Effluent "DATA"  
Influent "DATA"  
Effluent "DATA" 

首先，我在嘗試引用 cbSheet 組合框時遇到錯誤。 Variable Not Defined ； 此外，我只選擇了流入數據，並且不確定如何包含流出數據，因此它們會隨着每周添加新數據而正確交替。 有人可以幫我設置嗎？ 非常感謝你的幫助！

    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lRow1 As Long
    Dim lRow2 As Long
    Dim lRow3 As Long
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets(1)
    lRow1 = ws1.Cells(Rows.Count, 2).End(xlUp).Row
    lRow2 = ws1.Cells(Rows.Count, 3).End(xlUp).Row
    
    If ws1.Range("A8").Value <> "" Then
    Set ws2 = wb.Worksheets(cbSheet.Value)
    lRow3 = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    With ws1
    .Range("A13" & lRow1).Copy
    ws2.Range("A15" & lRow2).PasteSpecial xlPasteValues, Transpose:=True
    End With
    
    End If
    
End Sub

Answer 1

編輯：錯過了Transpose置位......

嘗試這個：

Sub Transfer()
    Dim wb As Workbook, ws2 As Worksheet, wsInput As Object 'not As Worksheet
    Dim cDest As Range, wsName, rngDest, v
    
    Set wb = ThisWorkbook
    Set wsInput = wb.Sheets(1)
    
    wsName = wsInput.cbSheet.Value
    If Len(wsName) > 0 Then
        If wsInput.Range("A8").Value <> "" Then
            Set cDest = wb.Worksheets(wsName).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            
            With wsInput.Range("B13:C" & wsInput.Cells(Rows.Count, "B").End(xlUp).Row)
                v = Application.Transpose(.Value)
                With cDest.Resize(.Columns.Count, .Rows.Count)
                    .Value = v
                    .Interior.Color = vbYellow
                    .Borders.LineStyle = xlContinuous
                    .Borders.Weight = xlThin
                End With
            End With
        
        End If
    Else
        MsgBox "First select a destination worksheet from the drop-down list!", _
               vbExclamation, "No destination selected"
    End If
End Sub

您不能將wsInput聲明為Worksheet ，因為“開箱即用” Worksheet 對象模型不包含名為“cbSheet”的成員。 通過將其聲明As Object ，成員在運行時而不是編譯時得到解析。