Question

我有一个sub，我想用它来将项目从多列列表框复制到电子表格上的命名区域。我遇到问题的子部分被评为“转移到桌子”（下图）。它不是复制到我的命名范围（“Import_Items”或“Export_Items”，它根据哪个表用作源来引用某些表），而是从列C开始复制到第1行。我觉得我是可能缺少一些非常简单的东西，任何帮助都会受到赞赏。

Sub Transfer()
Dim CopyToWB As Workbook
Dim ASName As String
Dim lItem As Long, lRows As Long, lCols As Long
Dim lColLoop As Long, lTransferRow As Long

Set CopyToWB = Workbooks.Open(FPath & "\" & FName)
ASName = ActiveSheet.Name
lRows = ItemsLB.ListCount - 1
lCols = ItemsLB.ColumnCount - 1

With CopyToWB.Sheets(ASName)
    Range(ASName & "_Date") = DateTB
    Range(ASName & "_Tool_Order") = ToolOrderTB
    Range(ASName & "_WAY_BILL") = TrackingTB
    Range(ASName & "_TPOC_Name") = TPOCNameTB
    Range(ASName & "_Site") = SiteTB
    Range(ASName & "_Street") = StreetTB
    Range(ASName & "_City_State") = CityStateTB
    Range(ASName & "_Zip") = ZipTB
    Range(ASName & "_SPOC_Name") = SPOCNameTB
    Range(ASName & "_SPOC_Phone") = PhoneTB
    Range(ASName & "_SPOC_Email") = SPOCEmailTB
    Range(ASName & "_TPOC_Email") = TPOCEmailTB


    'Transfer to table
    With Range(ASName & "_Items", ActiveSheet.Cells(lRows + 1, 4 + lCols)) 'Transfer to range
        For lItem = 0 To lRows
            'Increment variable for row transfer range
            lTransferRow = lTransferRow + 1
              'Loop through columns of selected row
              For lColLoop = 0 To lCols
                 'Transfer selected row to relevant row of transfer range
                 .Cells(lTransferRow, lColLoop + 1) = ItemsLB.List(lItem, lColLoop)
              Next lColLoop
        Next
    End With

    'Export/Import-dependent
    If ASName = "Export" Then
        Range(ASName & "_TPOC_Print_Name") = TPOCNameTB
        Range(ASName & "_TPOC_Title") = TPOCTitleTB
    ElseIf ASName = "Import" Then
        Range(ASName & "_Consignee_Name_Number") = TPOCNameTB & _
            " - " & TPOCPhoneTB
    End If

    Application.DisplayAlerts = False
    .SaveAs FPath & FName

    'Optional export to PDF
    If PDFChkBx = True Then
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=FPath & "Proforma Customs Invoice " & ToolOrderTB.Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    End If

    Application.DisplayAlerts = True
End With

End Sub

Answer 1

这是如何将整个列表一次性放入一个范围：

With Me.ItemsLB
    Range(ASName & "_Items").Resize(.ListCount, .ColumnCount).Value = .List
End With

以下是显式调整表格大小的示例：

Dim lo As ListObject

With Me.ItemsLB
    Set lo = Range(ASName & "_Items").ListObject
    lo.Resize lo.Range.Resize(.ListCount + 1, .ColumnCount)
    lo.DataBodyRange.Value = .List
End With

Excel 2010 VBA将多列Listbox传输到命名范围

1 个答案: