判断2列数据并平移

sero61

请大神指点，a列按顺序排列，b 列有区分。

     当a列有重复且b列为B时，把该行移到a列出现重复的第一行位置
   当a列无重复且b列为B时，把该行平移到右侧
自己写的代码出现了剪切被覆盖的情况，请大神写个代码。

longwin

sero61

在线顶一下 静待大神指点

Peny2020

可不可以理解为区分A,B，A的放在左边，B 的放在右边？

sero61

Peny2020 发表于 2024-8-20 11:02
可不可以理解为区分A,B，A的放在左边，B 的放在右边？

区分A和B, 有一种情况是a中相同b列不同的得根据a剪切到右边位置

Peny2020

试试是不是这样

longwin

Sub test()
    Set sh = Sheets("Sheet1")
    arr = sh.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If arr(i, 3) = "A" Then
            If Not d.exists(arr(i, 1)) Then d(arr(i, 1)) = i
        Else
            Set Rng = sh.Range("A" & i & ":F" & i)
            If d.exists(arr(i, 1)) Then
                sh.Range("G" & d(arr(i, 1)) & ":L" & d(arr(i, 1))).Value = Rng.Value
            Else
                Rng.Offset(0, 6).Value = Rng.Value
            End If
            Rng.Value = ""
        End If
    Next
Set d = Nothing
End Sub

sero61

longwin 发表于 2024-8-20 12:45

感谢指点 上数据测试一下看有不有其他特殊情况

sero61

Peny2020 发表于 2024-8-20 12:12
试试是不是这样

感谢支持，除了移动，对于A列中相同的需要移动到A列第一个出现的地方

Peny2020

sero61 发表于 2024-8-20 14:15
感谢支持，除了移动，对于A列中相同的需要移动到A列第一个出现的地方

那你看7楼的，我就不改了。