Question

我有数据集：

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

使用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是否可以实现。

谢谢！

Answer 1

这肯定可以在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ᴇʜ的评论进行编辑

Answer 2

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

Option Explicit

Public Sub UnPivotData()
    Dim wsSrc As Worksheet 'define source sheet
    Set wsSrc = ThisWorkbook.Worksheets("Source")

    Dim wsDest As Worksheet 'define output sheet
    Set wsDest = ThisWorkbook.Worksheets("Destination")

    Dim LastRow As Long 'find last used row
    LastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

    Dim LastCol As Long 'find last used column
    LastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column

    Dim srcArr As Variant 'read data range into an array (makes it faster)
    srcArr = wsSrc.Range("A1", wsSrc.Cells(LastRow, LastCol)).Value

    Dim OutRow As Long 'find next free output row in destination sheet.
    OutRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1

    Dim iRow As Long, iCol As Long
    For iRow = 2 To UBound(srcArr) 'loop through all rows
        For iCol = 3 To UBound(srcArr, 2) 'loop through month columns
            If srcArr(iRow, iCol) <> 0 Then 'check if quantity is not 0
                With wsDest.Cells(OutRow, 1) 'write everything
                    .Value = srcArr(iRow, 1)
                    .Offset(0, 1).Value = srcArr(iRow, iCol)
                    .Offset(0, 2).Value = srcArr(1, iCol)
                End With
                OutRow = OutRow + 1 'move to the next free row

                'Debug.Print srcArr(iRow, 1), srcArr(iRow, iCol), srcArr(1, iCol)
            End If
        Next iCol
    Next iRow
End Sub

或者，如果您也想使用更快速的方法使用数组进行输出

Option Explicit

Public Sub UnPivotDataFastOutput()
    Dim wsSrc As Worksheet 'define source sheet
    Set wsSrc = ThisWorkbook.Worksheets("Source")

    Dim LastRow As Long
    LastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

    Dim LastCol As Long
    LastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column

    Dim srcArr As Variant 'read data range into an array
    srcArr = wsSrc.Range("A1", wsSrc.Cells(LastRow, LastCol)).Value

    Dim OutRow As Long
    OutRow = 1

    Dim destRowCount As Long 'calculate array size
    destRowCount = Application.WorksheetFunction.CountIf(wsSrc.Range("C2", wsSrc.Cells(LastRow, LastCol)), "<>0")

    Dim destArr As Variant
    ReDim destArr(1 To destRowCount, 1 To 3)

    Dim iRow As Long, iCol As Long
    For iRow = 2 To UBound(srcArr)
        For iCol = 3 To UBound(srcArr, 2)
            If srcArr(iRow, iCol) <> 0 Then
                'output into array
                destArr(OutRow, 1) = srcArr(iRow, 1)
                destArr(OutRow, 2) = srcArr(iRow, iCol)
                destArr(OutRow, 3) = srcArr(1, iCol)
                OutRow = OutRow + 1

                'Debug.Print srcArr(iRow, 1), srcArr(iRow, iCol), srcArr(1, iCol)
            End If
        Next iCol
    Next iRow

    'write array into sheet
    ThisWorkbook.Worksheets("Destination").Range("A2").Resize(destRowCount, 3).Value = destArr
End Sub

Answer 3

尝试以下。

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

FileLock

假定数据如下。

如何在Excel VBA Macro和其他情况下执行行循环

3 个答案: