根据参考栏值合并EXCEL行

时间:2017-12-07 14:54:51

标签: excel excel-vba excel-formula vba

我想根据A列的引用值合并B列中的不同行,并将结果复制到C列。

输入:

CODE    NAME
110001  Baroda House
110001  Bengali Market
110002  Bhagat Singh Market
110002  Connaught Place
125051  Constitution House
125051  Election Commission
125051  Janpath
125051  Krishi Bhawan
125051  Lady Harding Medical College

预期产出:

CODE    NAME                ;MERGED
110001  Baroda House        ;Baroda House,Bengali Market
110001  Bengali Market      ;Baroda House,Bengali Market
110002  Bhagat Singh Market ;Bhagat Singh Market,Connaught Place
110002  Connaught Place     ;Bhagat Singh Market,Connaught Place
125051  Constitution House  ;Constitution House,Election Commission,Janpath,Krishi Bhawan,Lady Harding Medical College
125051  Election Commission ;Constitution House,Election Commission,Janpath,Krishi Bhawan,Lady Harding Medical College
125051  Janpath             ;Constitution House,Election Commission,Janpath,Krishi Bhawan,Lady Harding Medical College
125051  Krishi Bhawan       ;Constitution House,Election Commission,Janpath,Krishi Bhawan,Lady Harding Medical College

我尝试使用此处给出的宏,但它不起作用: Copying from reference column based on neighboring cell value

任何人都可以帮助我。 xlsx文件有114000行。谢谢。

1 个答案:

答案 0 :(得分:-1)

以下代码可以解决这个问题:

Sub foo()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Sheet3" Then 'if statement to exclude this sheet, add more if any need excluding
        LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'get the last row with data
        Repeated = 1
        For i = 2 To LastRow 'loop through rows
            Newvalue = ws.Cells(i, 1).Value 'get the code to compare
            For x = 2 To LastRow 'loop again for comparison
                If ws.Cells(x, 1).Value = Newvalue Then
                    Merged = Merged & "; " & ws.Cells(x, 2).Value 'if values match then get the merged value
                    Repeated = Repeated + 1 'Increment if match found
                    ID = ws.Cells(x, 1).Value
                End If
            Next x
            ws.Cells(i, 3).Value = Merged 'enter the value on column C
            ws.Cells(i, 4).Value = ID & " repeated " & Repeated - 1 & " times."
            Merged = "" 'Clear the variable for next loop
            Repeated = 1 'clear variable ready for next loop
        Next i
    End If
Next
End Sub
相关问题