单条件下的数值处理

zllyyz

数据处理问题（详见下图或附件，请大佬们援助，谢谢）：

shiruiqiang

d列做字典，从右边往左边遍历，不是的清空，是的停止循环。然后左边的清除掉

zllyyz

shiruiqiang 发表于 2024-2-24 16:16
d列做字典，从右边往左边遍历，不是的清空，是的停止循环。然后左边的清除掉

合计额，会有重复项……忘记写注意事项了，得添加所在行数作为条件吧

gwjkkkkk

Sub TEST1()
    Dim ar, i&, j&, r&, isFlag As Boolean
   
    r = Cells(Rows.Count, "D").End(xlUp).Row
    With Range("D5:R" & r)
        ar = .Value
        .Offset(1, 1).ClearContents
        For i = 2 To UBound(ar)
            isFlag = False
            If ar(i, 1) > 0 Then
                For j = UBound(ar, 2) To 2 Step -1
                    If isFlag Then
                        ar(i, j) = Empty
                    Else
                        If ar(i, j) <> ar(i, 1) Then
                            ar(i, j) = Empty
                        Else
                            isFlag = True
                        End If
                    End If
                Next j
            End If
        Next i
        .Value = ar
    End With
    Beep
End Sub

gwjkkkkk

请参考 附件 。。。

ykcbf1100

附件供参考。。。

ykcbf1100

1. Sub ykcbf()  '//2024.2.24
   
2.     r = Me.Cells(Rows.Count, 4).End(3).Row
   
3.     arr = Me.Range("a1:r" & r)
   
4.     For i = 6 To UBound(arr)
   
5.         s = Val(arr(i, 4))
   
6.         If s > 0 Then
   
7.             For j = UBound(arr, 2) To 5 Step -1
   
8.                 If Val(arr(i, j)) = s Then
   
9.                     st = Me.Cells(i, j)
   
10.                     Me.Cells(i, 5).Resize(1, UBound(arr, 2) - 4) = ""
    
11.                     Me.Cells(i, j) = st
    
12.                     Exit For
    
13.                 End If
    
14.             Next
    
15.         End If
    
16.     Next
    
17. End Sub
    
18. 
    

复制代码

参与一下。。

zllyyz

ykcbf1100 发表于 2024-2-24 18:29
附件供参考。。。

老师，你可能发错回帖了 附件和我的求助帖 不一样

ykcbf1100

zllyyz 发表于 2024-2-24 18:42
老师，你可能发错回帖了 附件和我的求助帖 不一样

不好意思，传错附件了，已更新。

半百