0

在此处输入图像描述

你好，我正在做一个复制列上的值的宏，VALUES1，VALUES2，VALUES3，如果当文章相同时它不为空。

我将拥有第一个电子表格，并且我希望宏返回第二个电子表格。

我已经设法做到了：

Sub test()

Dim i, last, j, x As Integer
Dim R As Range

last = Sheets("List2").Range("A100000").End(xlUp).Row - 2

For i = 0 To last

    Set R = Sheets("List2").Range("A2")

        If Not WorksheetFunction.CountIf(Sheets("List2").Columns(1), _
        Sheets("List2").Range("A2").Offset(i, 0).Value) = 0 Then

            For j = 1 To WorksheetFunction.CountIf(Sheets("List2").Columns(1), _

                Sheets("List2").Range("A2").Offset(i, 0).Value)
                Set R = Sheets("List2").Columns(1).Find(Sheets("List2").Range("A2"). _
                Offset(i, 0).Value, R, LookAt:=xlWhole)

                    For x = 0 To 2

                        If Not Sheets("List2").Range("B2").Offset(i, x).Value = "" Then

                            R.Offset(0, "1" + x).Value = Sheets("List2"). _ 
                            Range("B2").Offset(i, x).Value

                        End If
                    Next x
            Next j
        End If
Next i

End Sub

但是这个问题需要很长时间，因为我有大约 10.000 行和 20 列，而且电子表格不是按顺序排列的，所以可能是有一个混乱，比如 (A, B, B, A, .. .)

有没有办法让它更快更好？？？

非常感谢。石碑。

4

1 回答 1

2

这是一个非常简单的解决方案，其中包含针对您的问题的公式：

Sheet2!A1=Sheet1!A1
Sheet2!B1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!B:B)

Sheet2!C1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!C:C)
Sheet2!D1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!D:D)

将这些公式放在左侧的单元格中=并向下复制。您真的只需要前两个，因为您也可以将第二个复制到右侧。

您需要按文章对 Sheet1 进行排序。

就是这样。

当然，有时可能只需要使用 VBA 来实现它。通常使用 VBA 处理大量单元格的最快方法是使用范围的数组副本。使用工作表函数和循环访问单个单元格引用会大大减慢您的速度。

编辑：

这将是我的 VBA 解决方案

Public Sub Demo()
  Dim arrRange() As Variant
  Dim arrRangeResult() As Variant
  Dim i As Long
  Dim j As Long
  Dim copyVal As Variant
  Dim copyCond As Variant
  Dim copyCol As Long

  'create two copies of the origin data
  arrRange = Range("A:D")
  arrRangeResult = Range("A:D")

  'loop through first data-copy, downwards through the articles
  For i = LBound(arrRange, 1) + 1 To UBound(arrRange, 1)
    'stop loop, if no article was found
    If arrRange(i, 1) = "" Then Exit For
    'store current article ID
    copyCond = arrRange(i, 1)
    'loop sideways through value-columns
    For j = LBound(arrRange, 2) + 1 To UBound(arrRange, 2)
      'store value & column, when found
      If arrRange(i, j) <> "" Then
        copyVal = arrRange(i, j)
        copyCol = j
        Exit For
      End If
    Next j

    'loop through output array and paste value
    For j = LBound(arrRangeResult, 1) + 1 To UBound(arrRangeResult, 1)
      If arrRangeResult(j, 1) = copyCond Then
        'paste-down found value to all occurences of article
        arrRangeResult(j, copyCol) = copyVal
      ElseIf arrRangeResult(j, 1) = "" Then
        'early stop, when no article ID is found
        Exit For
      End If
    Next j
  Next i

  'create output
  Range("K:N") = arrRangeResult
End Sub
于 2012-11-20T12:14:49.867 回答