期待通过多个工作表循环Excel VBA宏?

时间:2017-12-21 17:20:28

标签: vba excel-vba excel

希望在Excel工作簿中通过(约)125个工作表循环以下代码,并将列出的单元格值拉到“数据库”工作表上的一个数据库条目日志中。现在它只是从其中一个标签中拉出来的。 (PO VT-0189)。想知道如何纠正。

Private Sub PopulateOrderInfo()
    Dim OrderDate As String, PONumber As String, Vendor As String, ShipTo As String, SKU As String
    Dim R As Long, LastSKURow As Long, NextDBRow As Long, OFrm As Worksheet, DB As Worksheet
    For Each OFrm In ActiveWorkbook.Worksheets
        Set OFrm = Worksheets("PO VT-0189")
        Set DB = Worksheets("Database")
        OrderDate = OFrm.Range("N4")
        PONumber = OFrm.Range("N3")
        Vendor = OFrm.Range("A13")
        ShipTo = OFrm.Range("I13")
        POTotal = OFrm.Range("P43")
        LastSKURow = OFrm.Range("A38").End(xlUp).Row
        For R = 21 To LastSKURow
            SKU = OFrm.Range("A" & R).Value
            SKUDesc = OFrm.Range("D" & R).Value
            SKUQty = OFrm.Range("K" & R).Value
            Lntotal = OFrm.Range("M" & R).Value
            NextDBRow = DB.Cells(DB.Rows.Count, "A").End(xlUp).Row + 1
            DB.Range("A" & NextDBRow).Value = OrderDate
            DB.Range("B" & NextDBRow).Value = PONumber
            DB.Range("C" & NextDBRow).Value = Vendor
            DB.Range("D" & NextDBRow).Value = ShipTo
            DB.Range("E" & NextDBRow).Value = SKU
            DB.Range("F" & NextDBRow).Value = SKUDesc
            DB.Range("G" & NextDBRow).Value = SKUQty
            DB.Range("H" & NextDBRow).Value = Lntotal
            DB.Range("I" & NextDBRow).Value = POTotal
        Next R
    Next OFrm
End Sub

4 个答案:

答案 0 :(得分:1)

我认为您也可以通过避免循环来缩短代码,而且大多数变量对我来说似乎都是不必要的。

Private Sub PopulateOrderInfo()

Dim R As Long, LastSKURow As Long, NextDBRow As Long, OFrm As Worksheet, DB As Worksheet

Set DB = Worksheets("Database")

For Each OFrm In ActiveWorkbook.Worksheets
    If OFrm.Name <> DB.Name Then
        LastSKURow = OFrm.Range("A38").End(xlUp).Row
        R = LastSKURow - 21 + 1
        NextDBRow = DB.Cells(DB.Rows.Count, "A").End(xlUp).Row + 1
        DB.Range("A" & NextDBRow).Resize(R).Value = OFrm.Range("N4")
        DB.Range("B" & NextDBRow).Resize(R).Value = OFrm.Range("N3")
        DB.Range("C" & NextDBRow).Resize(R).Value = OFrm.Range("A13")
        DB.Range("D" & NextDBRow).Resize(R).Value = OFrm.Range("I13")
        DB.Range("E" & NextDBRow).Resize(R).Value = OFrm.Range("A21").Resize(R).Value
        DB.Range("F" & NextDBRow).Resize(R).Value = OFrm.Range("D21").Resize(R).Value
        DB.Range("G" & NextDBRow).Resize(R).Value = OFrm.Range("K21").Resize(R).Value
        DB.Range("H" & NextDBRow).Resize(R).Value = OFrm.Range("M21").Resize(R).Value
        DB.Range("I" & NextDBRow).Resize(R).Value = OFrm.Range("P43")
    End If
Next OFrm

End Sub

答案 1 :(得分:0)

使用for循环和WorkSheets集合,如:

For I = 1 to worksheets.count
 if worksheets(i).name <> "Database" then 
  Add your code here
 end if
Next i

这将循环遍历工作簿中的每个工作表,并为除数据库之外的所有工作表执行所需的操作。

答案 2 :(得分:0)

使用for each...循环

For Each ws In wb.Worksheets 
     If ws.name = "Database" Then   
'Leave blank to just skip database. Code here if you want something special on database. OR statements can be used to exclude additional sheets
 Else 
'Code here  
 End If  
    Next 

答案 3 :(得分:0)

我认为你很好地描述了这个问题。只是为了确认,你想在一个工作簿中循环遍历所有工作表,对吧。试试下面的脚本。如果您有其他问题,疑虑等,请反馈。谢谢。

routes.rb