否则如何执行行循环

Posted 2023-02-28

我有数据集：

我想遍历所有列和行以选择非零值，然后将其与月份一起放入新表中：

使用VBA或Vlookup是否可以实现？

我的想法是：

For y in Item No Column
For x in Row
If Qty != 0, append to new sheet
Else go to the next cell

我不太确定VBA是否可以实现。

提前感谢！

答案

尝试吼叫。

在单元格中存储一对一的值会产生不好的结果。我不知道什么时候数据很小，但是在处理大量数据时它会变慢。我建议您养成使用变体数组的习惯。

Dim rstWs As Worksheet
Dim strSQL As String

Sub test()
    Dim vDB As Variant, vR()
    'vDB is static variant, vR() is Dynamic Variant
    Dim Ws As Worksheet, toWs As Worksheet
    Dim i As Long, j As Integer, n As Long
    Dim r As Long, c As Integer
    Dim wsName As String

    Set Ws = ActiveSheet ' Sheets("Special Name")

    vDB = Ws.Range("a1").CurrentRegion

    r = UBound(vDB, 1)
    c = UBound(vDB, 2)

    For i = 2 To r
        For j = 3 To c
            If vDB(i, j) <> 0 Then
                n = n + 1
                ReDim Preserve vR(1 To 3, 1 To n) 'get data with Tranpose type
                vR(1, n) = vDB(i, 1)
                vR(2, n) = vDB(i, j)
                vR(3, n) = vDB(1, j)
            End If
        Next j
    Next i
    Set toWs = Sheets.Add 'Sheets("Results")
    With toWs
        .UsedRange.Clear
        .Range("a1").Resize(1, 3) = Array("Item No", "Qty", "Month")
        .Range("a2").Resize(n, 3) = WorksheetFunction.Transpose(vR)
    End With
    Set rstWs = Sheets.Add

    wsName = toWs.Name

    strSQL = "Select [Item No], sum(Qty) as Qty "
    strSQL = strSQL & "FROM [" & wsName & "$] "
    strSQL = strSQL & "GROUP BY [Item No] "

    DoSQL
End Sub
Sub DoSQL()

    Dim Rs As Object
    Dim strConn As String
    Dim i As Integer

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & ThisWorkbook.FullName & ";" & _
            "Extended Properties=Excel 12.0;"


    Set Rs = CreateObject("ADODB.Recordset")
    Rs.Open strSQL, strConn

    If Not Rs.EOF Then
         With rstWs
            .Range("a1").CurrentRegion.ClearContents
            For i = 0 To Rs.Fields.Count - 1
               .Cells(1, i + 1).Value = Rs.Fields(i).Name
            Next
            .Range("a" & 2).CopyFromRecordset Rs
        End With
    End If
    Rs.Close
    Set Rs = Nothing
End Sub

假定数据如下。

另一答案

这肯定可以在VBA中完成。我建议将您的数据保存在三个不同的变量数组中，一个用于项目编号，一个用于月份，一个用于数量。您可以像这样读出值：

dim quantities, months, numbers as Variant

quantities = range("YourQuantityRange")
months = range("YourMonthRange")
numbers = range("YourNumberRange")

请注意，您必须将范围值替换为“ A2：A10”之类的范围，或者使用任何范围。我不知道您的值在原始工作表中的位置。

您还需要制作一张新纸，您可以像这样做

Dim mySheet As Worksheet
Set mySheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

然后，如果数字不是0，则可以像这样遍历数量数组并将正确的值打印到第二张纸上>

dim i as Long, j as Long, rowCounter as Long
rowCounter = 2 'in which line do you want your first row of data to be written in the second sheet

For i = 1 To UBound(quantities, 1)
    For j = 1 To UBound(quantities, 2)

        if quantities(i, j) <> 0 then
            mySheet.Cells(rowCounter, 1) = numbers(i,1) 'The second parameter of Cells() specifies the column so your item numbers will be pastet in the first column in this example
            mySheet.Cells(rowCounter, 2) = quantities(i,j)
            mySheet.Cells(rowCounter, 3) = months(1,j)
            rowCounter = rowCounter + 1
        end if

    Next
Next
注意，这会将您的值放在第二行的第一，第二和第三列中。您可以确定只编辑所需的值即可。

根据Pᴇʜ的评论编辑

另一答案

这是一个如何使用数组循环遍历数据的示例。