某小区12个微信群所有成员的信息用公式或代码从分表接龙合并一起

SHANGDU629

wangweihebtu 发表于 2023-2-2 11:53
主要是我水平不高，写不了复杂的代码，我就只能去想办法去从源头上减少难度

谢谢帮助！

ykcbf1100

SHANGDU629 发表于 2023-2-2 11:03
首先非常感谢老师您的帮助，接龙合并功能用代码非常快速实现了，但实际的功能离我的要求稍有一点点不一样 ...

我看一下

ykcbf1100

SHANGDU629 发表于 2023-2-2 11:03
首先非常感谢老师您的帮助，接龙合并功能用代码非常快速实现了，但实际的功能离我的要求稍有一点点不一样 ...

加上了群排序

zlzz1971

请用WPS运行

SHANGDU629

ykcbf1100 发表于 2023-2-2 15:13
加上了群排序

老师，顺序是按幢从小到大排列接龙非常成功了，真牛啊。但出现一个小意外，原有1492个群成员的，现在的方法变成1448个群成员，少了44个，查到原因了，少了【4幢】的44个，估计跟【2、4幢】后跟【4幢】再跟【2、4幢邻居】中【4幢】字符识别时都包含在【2、4幢】或【2、4幢邻居】中了。
最后再次对老师的帮助表示感谢！

SHANGDU629

zlzz1971 发表于 2023-2-2 15:42
请用WPS运行

首先非常感谢您的帮助！因WPS宏未使用过，一时不会用，但看到代码了，代码这么简单，真厉害。
因一时不会用，无法提出意见，敬请谅解。最后再次对你的帮助表示感谢！

SHANGDU629

ykcbf1100 发表于 2023-2-2 09:50
多表合并，测试通过。

老师，因后面这段代码看不懂，感觉好象有点多余，我把你的代码做了如下修正：
Sub 多表合并()     '//2023.2.2
    Dim arr, brr, d
    Set d = CreateObject("Scripting.Dictionary")
    Set sht = Sheets("合并")
    Dim tm: tm = Timer
    Application.ScreenUpdating = False
    With sht
        r = .Cells(.Rows.Count, "a").End(xlUp).Row
'        .Range("a6:h" & r).Clear '
        .Range("a6:F" & r).Clear '楼改
  
    End With
    m = 0: N = 0: y = 0
    For Each sh In Sheets
        If sh.Name <> sht.Name Then
            N = N + 1
            With sh
                For x = 1 To 4
                    y = y + 1
                    l = (x - 1) * 7
                    s = .Cells(2, 2 + l)
                    d(s) = .Cells(2, 5 + l)
                    r1 = .Cells(.Rows.Count, 2 + l).End(xlUp).Row
                    r = IIf(y = 1, 6, sht.Cells(sht.Rows.Count, "a").End(xlUp).Row + 1)
                    If r1 > 3 Then .Range(.Cells(4, 1 + l), .Cells(r1, 7 + l)).Copy sht.Cells(r, 1)
                Next
            End With
        End If
    Next
'    With sht '楼：上面已复制成功，只不过A列顺序不对，故只要解决A列排序即可。
'        arr = .[i3:t4]
'        For j = 1 To UBound(arr, 2)
'            s = arr(1, j)
'            arr(2, j) = d(s)
'        Next
'        .[i3:t4] = arr
'        r = .Cells(.Rows.Count, "a").End(xlUp).Row
'        .[b2] = y & "个群成员": .[e2] = r - 5: .[u4] = r - 5
'        For j = 6 To r
'            m = m + 1
'            .Cells(j, 1) = m           '//序列号
'        Next j
'        .Range("a6:h" & r).Borders.LineStyle = 1
'    End With
'    Range("A6").Select
'    Range(Selection, Selection.End(xlDown)).Select
    Set sht = Sheets("合并") '楼：上面不要，改成下面简单的A列赋序号。
    With sht
        r = .Cells(.Rows.Count, "a").End(xlUp).Row
    End With
            For j = 6 To r
            m = m + 1
            Cells(j, 1) = m           '//序列号
        Next j '楼：改成此。
    Application.ScreenUpdating = True
    MsgBox "合并完毕，共用时： " & Format(Timer - tm, "0.000秒"), , "提示"
End Sub
若有改错，敬请理解。