看齐

ddz79101

老师！想将C列和D列（两列同一关系）中的C列按A列中单元格中间部分对齐，请老师指点。谢谢！

shiruiqiang

c列作字典，判断是否在a列内

ddz79101

shiruiqiang 发表于 2024-6-30 06:56
c列作字典，判断是否在a列内

老师！早上好！是的！但要和A列中红色字对齐。

liulang0808

Sub 按钮1_Click()
    r = ActiveSheet.UsedRange.Rows.Count
    Set d = CreateObject("scripting.dictionary")
    Arr = [a1].Resize(r, 4)
    For j = 2 To UBound(Arr)
        If Len(Arr(j, 1)) > 0 Then
            x = Split(Arr(j, 1), "_")(1)
            d(x) = j
            Arr(j, 1) = ""
            Arr(j, 2) = ""
        End If
    Next j
    For j = 2 To UBound(Arr)
        If d.exists(Arr(j, 3)) Then
            Arr(d(Arr(j, 3)), 1) = "'" & Arr(j, 3)
            Arr(d(Arr(j, 3)), 2) = Arr(j, 4)
        End If
    Next j
    Arr(1, 1) = "编码"
    Arr(1, 2) = "名称"
    [m1].Resize(UBound(Arr), 2) = Arr
End Sub

liulang0808

。。。。。。。。。。。。。。

Qs18

Sub qs() '2024/6/30
    Dim arr, brr, i, crr
    With Sheet1
        arr = .Range("a1").CurrentRegion: ReDim crr(1 To UBound(arr), 1 To 2)
        brr = .Range("d1").CurrentRegion
        crr(1, 1) = "编码": crr(1, 2) = "名称"
        For i = 2 To UBound(brr)
            For j = 2 To UBound(arr)
                If InStr(arr(j, 1), brr(i, 1)) Then
                    crr(j, 1) = "'" & brr(i, 1)
                    crr(j, 2) = "'" & brr(i, 2)
                    Exit For
                End If
            Next
        Next
        .Range("g1").Resize(UBound(crr), 2) = crr
    End With
    MsgBox "ok!"
End Sub

Qs18

试试....................

Qs18

试试...............

今铭昔

zhangcheng6688

学习一下字典，打扰了
Sub test()
Arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(Arr)
   s = Split(Arr(i, 1), "_")(1)
   d(s) = i
Next
Brr = [c2].CurrentRegion
ReDim crr(1 To UBound(Arr), 1 To 2)
crr(1, 1) = "编码": crr(1, 1) = "名称"
For j = 2 To UBound(Brr)
   r = d(Brr(j, 1))
   crr(r, 1) = Brr(j, 1)
   crr(r, 2) = Brr(j, 2)
Next
[g1].Resize(UBound(crr), 2) = crr
End Sub