Excel vba根据条件合并

Question

根据a列与d列，可以得到a列中哪些人是叔伯兄弟，如图e列为手动输入的叔伯兄弟，除了e列，都是现有的数据。实际上要用到的列只有a,b,d三列，用vba.

求e列

Answer 1

数据量不多的话没必要通过字典过桥，直接借用一个空的工作表作为过桥即可，我是通过SHEET3

代码如下

Sub 父子关系1()

On Error Resume Next

Sheets("Sheet3").Cells.Select

Selection.ListObject.QueryTable.Delete

Sheets("Sheet3").Select

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _

"ODBC;DSN=Excel Files;DBQ=C:\Documents and Settings\xd\桌面\工作簿1.xlsm;DefaultDir=C:\Documents and Settings\xd\桌面;DriverId=1046;MaxBuffe" _

), Array("rSize=2048;PageTimeout=5;")), Destination:=Range("$A$1")).QueryTable

.CommandText = Array( _

"SELECT AA.A, AA.B, BB.A, BB.B" & Chr(13) & "" & Chr(10) & "FROM AA AA, BB BB" & Chr(13) & "" & Chr(10) & "WHERE AA.B = BB.A")

.PreserveFormatting = True

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = True

.ListObject.DisplayName = "表_查询来自_Excel_Files"

End With

Sheets("Sheet1").Select

For J = 1 To Sheet1.[b65536].End(xlUp).Row

For I = 1 To Sheet3.[b65536].End(xlUp).Row

If Sheet1.Cells(J, 4) <> "" And Sheet1.Cells(J, 4) = Sheet3.Cells(I, 4) And Sheet1.Cells(J, 2) <> Sheet3.Cells(I, 2) Then

TEMP = TEMP & Sheet3.Cells(I, 1)

End If

Next

Sheet1.Cells(J, 5) = TEMP

TEMP = ""

Next

End Sub

追问

这位同学，你的代码好长哦，可以简短一些吗？或者用字典，最后一行你的结果中的姓名与姓名之间没有逗号

追答

不在长短，在于好用，能用就是好的，如果是想研究字典的，自己可以琢磨一下，或者向楼上付点小钱，知识也值钱啊，理论是一样的。另外那个逗号在自已加一下不就好了么？
TEMP = TEMP & "," & Sheet3.Cells(I, 1)
Sheet1.Cells(J, 5) = Mid(TEMP, 2, 500)

追问

谢了

Answer 2

合并excel机器人可以自动将同一文件夹中的excel按自定义行数进行合并。合并excel：https://store.uibot.com.cn/robots/detail/918.html

Answer 3

Sub ssss()

Dim ARows As Integer
Dim DRows As Integer
Dim ERows As Integer
Dim GrandfatheName As String
Dim AMaxR As Integer

AMaxR = Range("A65535").End(xlUp).Row

ARows = 2
Do While ARows <= AMaxR
   If ActiveSheet.Cells(ARows, 4).Value <> "" Then
      GrandfatheName = ActiveSheet.Cells(ARows, 4).Value
      DRows = ARows + 1
      Do While DRows <= AMaxR
         If ActiveSheet.Cells(ARows, 1).Value <> ActiveSheet.Cells(DRows, 1).Value And ActiveSheet.Cells(DRows, 4).Value = GrandfatheName Then
            If ActiveSheet.Cells(ARows, 5).Value = "" Then
               ActiveSheet.Cells(ARows, 5).Value = ActiveSheet.Cells(DRows, 1).Value
            Else
               ActiveSheet.Cells(ARows, 5).Value = ActiveSheet.Cells(ARows, 5).Value & "," & ActiveSheet.Cells(DRows, 1).Value
            End If
            If ActiveSheet.Cells(DRows, 5).Value = "" Then
               ActiveSheet.Cells(DRows, 5).Value = ActiveSheet.Cells(ARows, 1).Value
            Else
               ActiveSheet.Cells(DRows, 5).Value = ActiveSheet.Cells(DRows, 5).Value & "," & ActiveSheet.Cells(ARows, 1).Value
            End If
         End If
         DRows = DRows + 1
      Loop
   End If
   ARows = ARows + 1
Loop

End Sub

追问

我尽快试一下

本回答被提问者采纳

Answer 4

没了，早已被计划生育挤掉了。
用字典的嵌套就能完成。不免费。追问

你这杂种，免费治疗你这废物

追答

Answer 5

d列字典去重
B列字典去重，再剔除D列
A列字典剔除B、D