跨加密工作簿 横向匹配判断输入数据

CYZ凡星点点

ykcbf1100 发表于 2024-2-16 22:06
代码供参考。。。

ykcbf1100老师，改了路径后，执行显示OK但是，总单没有变化？

CYZ凡星点点

fzxba 发表于 2024-2-17 09:46

fzxba老师，执行出问题的发上来，你在看看

fzxba

CYZ凡星点点 发表于 2024-2-17 10:02
fzxba老师，执行出问题的发上来，你在看看

1. Sub test0()
   
2.   
   
3.   Dim strFile As String
   
4.   
   
5.   'With Application.FileDialog(msoFileDialogOpen)
   
6.   '.InitialFileName = ThisWorkbook.Path
   
7.   'With .Filters
   
8.   '.Clear
   
9.   '.Add "Excel Files", "*.xls*"
   
10.   'End With
    
11.   '.AllowMultiSelect = False
    
12.   'If .Show Then strFile = .SelectedItems(1) Else Exit Sub
    
13.   'End With
    
14.   
    
15.   strFile = "E:\总单.xls"
    
16.   If Dir(strFile) = "" Then MsgBox strFile & " 文件不存在！", 64: Exit Sub
    
17.   
    
18.   DoApp False
    
19.   
    
20.   Dim ar, br, cr() As Long, Dict As Object
    
21.   Dim wkb As Workbook, wks As Worksheet
    
22.   Dim i As Long, j As Long
    
23.   Dim idx As Long, pos As Long, cnt As Long
    
24.   
    
25.   pos = 254
    
26.   Set Dict = CreateObject("Scripting.Dictionary")
    
27.   
    
28.   Set wkb = Workbooks.Open(strFile, 0, False, , "123", "123")
    
29.   Set wks = wkb.Worksheets("Sheet2")
    
30.   With wks
    
31.     .Unprotect "456"  '原的没密码保护工作表
    
32.     With .Range("A1").CurrentRegion
    
33.       br = .Columns(2).Value
    
34.       ar = .Offset(, 2).Resize(, pos)
    
35.       ReDim cr(1 To UBound(br))
    
36.     End With
    
37.     For i = 1 To UBound(br) Step 3
    
38.       If Not Dict.Exists(br(i, 1)) Then Dict.Add br(i, 1), i
    
39.       ar(i, pos) = "|"
    
40.       For j = 1 To UBound(ar, 2) - 1
    
41.         If Len(ar(i, j)) Then
    
42.           ar(i, pos) = ar(i, pos) & ar(i, j) & "|" & ar(i + 1, j) & "|" & ar(i + 2, j) & "|"
    
43.           cr(i) = cr(i) + 1
    
44.         Else
    
45.           Exit For
    
46.         End If
    
47.       Next
    
48.     Next
    
49.   End With
    
50.   
    
51.   With ThisWorkbook.Worksheets("Sheet1")
    
52.     .Unprotect "456"
    
53.     br = .Range("AA1", .Cells(.Rows.Count, "X").End(xlUp))
    
54.     .Unprotect "456"
    
55.   End With
    
56.   For i = 2 To UBound(br)
    
57.     If Dict.Exists(br(i, 1)) Then
    
58.       idx = Dict(br(i, 1))
    
59.       If InStr(ar(idx, pos), "|" & br(i, 2) & "|" & br(i, 3) & "|" & br(i, 4) & "|") = 0 Then
    
60.         cr(idx) = cr(idx) + 1
    
61.         For j = 2 To UBound(br, 2)
    
62.           ar(idx + j - 2, cr(idx)) = br(i, j)
    
63.           ar(idx, pos) = ar(idx, pos) & br(i, j) & "|"
    
64.         Next
    
65.         cnt = cnt + 1
    
66.       End If
    
67.     End If
    
68.   Next
    
69.   
    
70.   If cnt Then wks.Range("C1").Resize(UBound(ar), WorksheetFunction.Max(cr)) = ar
    
71.   wks.Protect "456"  '设密码保护工作表
    
72.   wkb.Close True
    
73.   
    
74.   Set wks = Nothing
    
75.   Set wkb = Nothing
    
76.   Set Dict = Nothing
    
77.   
    
78.   DoApp True
    
79.   MsgBox cnt & " 条数据更新", 64
    
80. End Sub
    
81. 
    
82. Function DoApp(Optional b As Boolean = True)
    
83.   With Application
    
84.     .ScreenUpdating = b
    
85.     .DisplayAlerts = b
    
86.     .Calculation = -b * 30 - 4135
    
87.   End With
    
88. End Function

复制代码

fzxba

CYZ凡星点点 发表于 2024-2-17 10:02
fzxba老师，执行出问题的发上来，你在看看

原来的没密码现在传的有密码保护.rar (44.43 KB, 下载次数: 11)

2024-2-17 10:14 上传

点击文件名下载附件

CYZ凡星点点

fzxba 发表于 2024-2-17 10:14

感谢fzxba老师，能流畅运行了。

ykcbf1100

CYZ凡星点点 发表于 2024-2-17 09:52
ykcbf1100老师，改了路径后，执行显示OK但是，总单没有变化？

你的路径改错了，应该是:f="e:\总单.xls"