加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 （https://www.lidatong.com.cn/）- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置： 首页 > 百科 > 正文

Excel VBA实现按数据第一列进行GroupBy操作并连接数据

发布时间：2020-12-17 08:01:48 所属栏目：百科 来源：网络整理
导读：今天PHP站长网 52php.cn把收集自互联网的代码分享给大家，仅供参考。 Sub InitialData() Sheets("Sheet1").Select Range("B27").Select ActiveCell.FormulaR1C1 = "len("""")" Range("B35").Select ActiveCell.FormulaR1C

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

Sub InitialData()
    Sheets("Sheet1").Select
    Range("B27").Select
    ActiveCell.FormulaR1C1 = "len("""")"
    Range("B35").Select
    ActiveCell.FormulaR1C1 = "code(""t"")"
    Range("B36").Select
    Sheets("Sheet2").Select
    Range("K22").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K23").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K24").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K25").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K26").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K27").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K28").Select
    ActiveCell.FormulaR1C1 = "zip002"
    Range("K29").Select
    ActiveCell.FormulaR1C1 = "zip003"
    Range("K30").Select
    ActiveCell.FormulaR1C1 = "zip004"
    Range("K31").Select
    ActiveCell.FormulaR1C1 = "zip005"
    Range("K32").Select
    ActiveCell.FormulaR1C1 = "zip006"
    Range("K33").Select
    ActiveCell.FormulaR1C1 = "zip007"
    Range("K34").Select
    ActiveCell.FormulaR1C1 = "zip008"
    Range("K35").Select
    ActiveCell.FormulaR1C1 = "zip009"
    Range("K36").Select
    ActiveCell.FormulaR1C1 = "zip010"
    Range("K37").Select
    ActiveCell.FormulaR1C1 = "zip010"
    Range("K38").Select
    ActiveCell.FormulaR1C1 = "zip011"
    Range("K39").Select
    ActiveCell.FormulaR1C1 = "zip012"
    Range("K40").Select
    ActiveCell.FormulaR1C1 = "zip013"
    Range("K41").Select
    ActiveCell.FormulaR1C1 = "zip014"
    Range("K42").Select
    ActiveCell.FormulaR1C1 = "zip015"
    Range("K43").Select
    ActiveCell.FormulaR1C1 = "zip016"
    Range("K44").Select
    ActiveCell.FormulaR1C1 = "zip017"
    Range("K45").Select
    ActiveCell.FormulaR1C1 = "zip018"
    Range("L22").Select
    ActiveCell.FormulaR1C1 = "aceO1"
    Range("L23").Select
    ActiveCell.FormulaR1C1 = "aceO2"
    Range("L24").Select
    ActiveCell.FormulaR1C1 = "aceO3"
    Range("L25").Select
    ActiveCell.FormulaR1C1 = "aceO4"
    Range("L26").Select
    ActiveCell.FormulaR1C1 = "aceO5"
    Range("L27").Select
    ActiveCell.FormulaR1C1 = "aceO6"
    Range("L28").Select
    ActiveCell.FormulaR1C1 = "rar_ace"
    Range("L29").Select
    ActiveCell.FormulaR1C1 = "aceO8"
    Range("L30").Select
    ActiveCell.FormulaR1C1 = "aceO9"
    Range("L31").Select
    ActiveCell.FormulaR1C1 = "aceO10"
    Range("L32").Select
    ActiveCell.FormulaR1C1 = "aceO11"
    Range("L33").Select
    ActiveCell.FormulaR1C1 = "aceO12"
    Range("L34").Select
    ActiveCell.FormulaR1C1 = "aceO13"
    Range("L35").Select
    ActiveCell.FormulaR1C1 = "aceO14"
    Range("L36").Select
    ActiveCell.FormulaR1C1 = "rar_ace"
    Range("L37").Select
    ActiveCell.FormulaR1C1 = "aceO16"
    Range("L38").Select
    ActiveCell.FormulaR1C1 = "aceO17"
    Range("L39").Select
    ActiveCell.FormulaR1C1 = "aceO18"
    Range("L40").Select
    ActiveCell.FormulaR1C1 = "aceO19"
    Range("L41").Select
    ActiveCell.FormulaR1C1 = "aceO20"
    Range("L42").Select
    ActiveCell.FormulaR1C1 = "aceO21"
    Range("L43").Select
    ActiveCell.FormulaR1C1 = "aceO22"
    Range("L44").Select
    ActiveCell.FormulaR1C1 = "aceO23"
    Range("L45").Select
    ActiveCell.FormulaR1C1 = "aceO24"
    Range("L46").Select
    Sheets("Sheet3").Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "ttt"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "ttt"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("N5").Select
    ActiveCell.FormulaR1C1 = "ttt"
    Range("N13").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("N14").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("N15").Select
    ActiveCell.FormulaR1C1 = "ttt"
End Sub


Sub GroupData()
With Worksheets("Sheet2")
    Dim EndRow As Long
    Dim CompanyEndRow As Long
    Dim r As Range
    Dim FindCell As Range
    Dim CompanyCount As Integer
    
    .Activate
    EndRow = IIf(.Range("K22").End(xlDown).Row = 1048576,22,.Range("K22").End(xlDown).Row)
    CompanyEndRow = IIf(Worksheets("Sheet3").Range("C3").End(xlDown).Row = 1048576,3,Worksheets("Sheet3").Range("F3").End(xlDown).Row)
    Worksheets("Sheet3").Range("C3:" & "D" & CompanyEndRow).ClearContents
    Worksheets("Sheet3").Range("F3:" & "H" & (3 + 9 * 3 - 1)).ClearContents
    Worksheets("Sheet3").Range("J3:" & "L" & (3 + 9 * 3 - 1)).ClearContents
    Worksheets("Sheet3").Range("J3:" & "L" & (3 + 9 * 3 - 1)).ClearContents
    Worksheets("Sheet3").[O3:O5].ClearContents
    Worksheets("Sheet3").[O13:O15].ClearContents
    .Range("K22:K" & EndRow).AdvancedFilter Action:=xlFilterCopy,CopyToRange:=Worksheets("Sheet3").Range("C3"),Unique:=True
    With Worksheets("Sheet3")
        If .Range("C3").End(xlDown).Row = 1048576 Then
            CompanyEndRow = 3
        Else
            .Range("C3:C" & .Range("C3").End(xlDown).Row).RemoveDuplicates Columns:=1,Header:=xlNo
            CompanyEndRow = IIf(.Range("C3").End(xlDown).Row = 1048576,.Range("C3").End(xlDown).Row)
        End If
    End With
    For Each r In .Range("K22:K" & EndRow)
        If r.Offset(0,1).Value <> "rar_ace" Then
            Set FindCell = Worksheets("Sheet3").Range("C3:C" & CompanyEndRow).Find(What:=r.Value,After:=Worksheets("Sheet3").Range("C3"),LookIn:=xlFormulas,LookAt _
                :=xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:= _
                False,MatchByte:=False,SearchFormat:=False)
            If Not FindCell Is Nothing Then
                    FindCell.Offset(0,1).Value = IIf(FindCell.Offset(0,1).Value = "",r.Offset(0,1).Value,FindCell.Offset(0,1).Value & "," & r.Offset(0,1).Value)
            End If
        End If
    Next r
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    With Worksheets("Sheet3")
        For Each r In .Range("C3:C" & CompanyEndRow)
            CompanyCount = CompanyCount + 1
            If CompanyCount <= 9 Then
                .Range("F" & (3 + (CompanyCount - 1) * 3)).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("F" & (3 + (CompanyCount - 1) * 3) + 1).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("F" & (3 + (CompanyCount - 1) * 3) + 2).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("G" & (3 + (CompanyCount - 1) * 3)).Value = "A"
                .Range("G" & (3 + (CompanyCount - 1) * 3) + 1).Value = .Range("D" & (3 + CompanyCount - 1)).Value
                .Range("G" & (3 + (CompanyCount - 1) * 3) + 2).Value = "B"
                .Range("H" & (3 + (CompanyCount - 1) * 3)).Value = "AA"
                .Range("H" & (3 + (CompanyCount - 1) * 3) + 1).Value = "BB"
                .Range("H" & (3 + (CompanyCount - 1) * 3) + 2).Value = "CC"
            Else
                .Range("J" & (3 + (CompanyCount - 9 - 1) * 3)).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("J" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("J" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("K" & (3 + (CompanyCount - 9 - 1) * 3)).Value = "A"
                .Range("K" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = .Range("D" & (3 + CompanyCount - 1)).Value
                .Range("K" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = "B"
                .Range("L" & (3 + (CompanyCount - 9 - 1) * 3)).Value = "AA"
                .Range("L" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = "BB"
                .Range("L" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = "CC"
            End If
        Next r
        CompanyEndRow = IIf(.Range("F3").End(xlDown).Row = 1048576,.Range("F3").End(xlDown).Row)
        For Each r In .Range("F3:F" & CompanyEndRow)
            .[O3].Value = IIf(.[O3].Value = "",r.Value,.[O3].Value & "|" & r.Value)
            .[O4].Value = IIf(.[O4].Value = "",.[O4].Value & "|" & r.Offset(0,1).Value)
            .[O5].Value = IIf(.[O5].Value = "",2).Value,.[O5].Value & "|" & r.Offset(0,2).Value)
        Next r
        CompanyEndRow = IIf(.Range("J3").End(xlDown).Row = 1048576,.Range("J3").End(xlDown).Row)
        For Each r In .Range("J3:J" & CompanyEndRow)
            .[O13].Value = IIf(.[O13].Value = "",.[O13].Value & "|" & r.Value)
            .[O14].Value = IIf(.[O14].Value = "",.[O14].Value & "|" & r.Offset(0,1).Value)
            .[O15].Value = IIf(.[O15].Value = "",.[O15].Value & "|" & r.Offset(0,2).Value)
        Next r
        .Activate
    End With
    With Worksheets("Sheet1")
        .[C3].Formula = "=" & .[B27].Value & ""
        .[C7].Formula = "=" & .[B35].Value & ""
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End With
End Sub

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
    相关内容
      推荐文章
        站长推荐
        热点阅读

          【免责声明】本站内容转载自互联网，其发布内容言论不代表本站观点，如果其链接、内容的侵犯您的权益，烦请提交相关链接至邮箱bqsm@foxmail.com我们将及时予以处理。

          建议您使用1920×1080分辨率、谷歌浏览器Google Chrome、Microsoft Edge以获得本站的最佳浏览效果

          Copygight © 2008-2022 https://www.lidatong.com.cn/ All Rights Reserved. 李大同