Question

我需要编写一个代码，该代码将遍历工作簿中的工作表并复制每个工作表中位于单元格A7中的信息。我还需要它跳过重复操作，例如，如果多个工作表中单元格A7中的信息相同，我只需要将其复制一次到“数据质量”工作表中的单元格B4中，然后移动到另一工作表，直到发现不同信息，然后将新信息复制到C4等中。

这是开始循环的代码的开头：

InputData()

    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        Set DestSh = Sheets("Data Quality")
        For Each sh In ActiveWorkbook.Worksheets
            Select Case sh.Name
                Case DestSh.Name, "Overall Summary", "Confidence Level", "Standard Reporting Rules"
                Case Else

在这里，我需要输入代码以将信息从每张纸上的单元格A7复制到第4行（从B列开始），并且是否有重复项要删除它们。

Answer 1

将对评论中的两个选项均显示常规（均为未经测试）：

词典：

dim dc as scripting.dictionary, i as long, ws as worksheet
set dc as new scripting.dictionary
for each ws in worksheets
    dc(ws.cells(7,1).value)=ws.cells(7,1).value 
next
sheets("data quality").cells(4,2).resize(,dc.count+2).value = application.transpose(dc.keys)

match（）：

dim ws as worksheet, lcd as long
for each ws in worksheets
    with sheets("data quality")
        if isempty(.cells(4,2).value) then
            lcd = 2
        else
            lcd = .cells(4,.columns.count).end(xltoleft).columns
        end if
        if not application.match(ws.cells(7,1).value,.range(.cells(4,2),.cells(4,lcd)),0) then .cells(4,lcd+1).value = ws.cells(7,1).value
    end with
next

Answer 2

另一个使用For Each Loop和CounntIf的答案

Dim ws As Worksheet, c As Long
c = 2

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data Quality" Then
            Sheets("Data Quality").Cells(4, c).Value = ws.Cells(7, 1).Value
        c = c + 1
        End If
    Next ws

    With Sheets("Data Quality")
    Dim lCol As Long, cnt As Long
    lCol = Cells(4, Columns.Count).End(xlToLeft).Column

        For x = lCol To 2 Step -1
        cnt = Application.WorksheetFunction.CountIf(Range(Cells(4, 2), Cells(4, x)), Cells(4, x))
            If cnt > 1 Then Cells(4, x).Delete Shift:=xlToLeft
        Next x
    End With

循环浏览工作簿中的电子表格，然后将信息复制到第4行（从B列开始）

2 个答案: