如何按条件删除行后再写值

sampsonpon

具体描述如下：

autohotey

你这逻辑都是冲突的，怎么可能实现？

sampsonpon

autohotey 发表于 2024-11-11 17:08
你这逻辑都是冲突的，怎么可能实现？

怎么会冲突呢？这就跟IF函数一个意思

z865593849

按条件删除行后再写值

autohotey

sampsonpon 发表于 2024-11-11 17:16
怎么会冲突呢？这就跟IF函数一个意思

好吧 实际文件数据是不冲突的

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.11
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     a = [{"MTSOL","MTASS","PDB","PDC","PDX","PDD"}]
   
6.     b = [{"HQB","ZPB","JJB","ZSB","PDX","PDD"}]
   
7.     For x = 1 To UBound(a)
   
8.         d(a(x)) = b(x)
   
9.     Next
   
10.     With Sheets("Picking List")
    
11.         r = .Cells(Rows.Count, 1).End(3).Row
    
12.         arr = .[a1].Resize(r, 7)
    
13.     End With
    
14.     ReDim brr(1 To r, 1 To 7)
    
15.     For i = 2 To UBound(arr)
    
16.         s = arr(i, 6)
    
17.         d1(s) = ""
    
18.     Next
    
19.     Min = Date
    
20.     For Each k In d1.keys
    
21.         rq = CDate(Replace(k, ".", "/"))
    
22.         Min = IIf(Min > rq, rq, Min)
    
23.         If rq = Min Then d1.Remove k
    
24.     Next
    
25.     For i = 2 To UBound(arr)
    
26.         For Each k In d1.keys
    
27.             If arr(i, 6) = k Then
    
28.                 m = m + 1
    
29.                 For j = 1 To UBound(arr, 2)
    
30.                     brr(m, j) = arr(i, j)
    
31.                 Next
    
32.                 st = brr(m, 5)
    
33.                 s = ston(st)
    
34.                 If d.exists(s) Then
    
35.                     brr(m, 7) = d(s)
    
36.                 Else
    
37.                     brr(m, 7) = ""
    
38.                 End If
    
39.             End If
    
40.         Next
    
41.     Next
    
42.     With Sheets("结果")
    
43.         .UsedRange.Offset(1).ClearContents
    
44.         .[a2].Resize(m, 7) = brr
    
45.     End With
    
46.     Set d = Nothing
    
47.     Application.ScreenUpdating = True
    
48.     MsgBox "OK！"
    
49. End Sub
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&
   
    ar = [A1].CurrentRegion.Value
    br = [{"MTSOL","HQB";"MTASS","ZPB";"PDB","ZSB";"PDC","JJB";"PDX","PDX";"PDD","PDD"}]
   
    With CreateObject("VBScript.RegExp")
        For i = 2 To UBound(ar)
            ar(i, 7) = Empty
            For j = 1 To UBound(br)
                .Pattern = "^" & br(j, 1)
                If .test(ar(i, 5)) Then ar(i, 7) = br(j, 2): Exit For
            Next j
        Next i
    End With
   
    [A1].CurrentRegion.Value = ar
    Beep
End Sub

gwjkkkkk

参与一下。。。

sampsonpon

z865593849 发表于 2024-11-11 17:22
按条件删除行后再写值

Very Good!
但是在识别日期时遇到问题了：我改了几个日期实测了一下，例如7.11.2024、8.11.2024、9.11.2024、10.11.2024，结果它把10.11.2024给删了，应该删掉7.11.2024才是我想要的结果。它是在比较第一位数字，比较完第一位再比较第二位数字，而我是想要谁日期最早就删谁(这里日期格式为dd.mm.yyyy)