跨工作簿取数。如何根据标题取数。

ykcbf1100

lgzxmlg 发表于 2024-3-4 12:13
老师不好意思，个人疏忽了。

你分表中，故障描述有三个字段的,都取吗？

ykcbf1100

lgzxmlg 发表于 2024-3-4 10:10
老师对不起附件发错了。再帮忙看下。

代码已更新。。。

ykcbf1100

工作簿采用动态选择，分表名改变也不用改代码了。

1. Sub ykcbf()  '//2024.3.4
   
2.     Set Fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Set ws = ThisWorkbook
   
6.     Set sh = ws.Sheets("报修记录")
   
7.     With sh
   
8.         col = .Cells.Find("*", SearchOrder:=xlByColumns, searchdirection:=xlPrevious).Column
   
9.         For j = 1 To col
   
10.             s = .Cells(1, j)
    
11.             d(s) = j
    
12.         Next
    
13.     End With
    
14.     p = ThisWorkbook.Path & ""
    
15.     ReDim brr(1 To 10000, 1 To 100)
    
16.     With Application.FileDialog(msoFileDialogFilePicker)
    
17.         .InitialFileName = p
    
18.         .Title = "请选择对应Excel文件"
    
19.         .AllowMultiSelect = False
    
20.         .Filters.Clear
    
21.         .Filters.Add "Excel文件", "*.xls*"
    
22.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
23.     End With
    
24.     Set wb = Workbooks.Open(f, 0)
    
25.     With wb.Sheets(1)
    
26.         c = .Cells.Find("*", SearchOrder:=xlByColumns, searchdirection:=xlPrevious).Column
    
27.         c1 = .Rows(1).Find("故障描述1", , , , , 1).Column
    
28.         r = .Cells(Rows.Count, c1).End(3).Row
    
29.         arr = .[a1].Resize(r, c)
    
30.         wb.Close False
    
31.     End With
    
32.     For i = 2 To UBound(arr)
    
33.         m = m + 1
    
34.         For j = 1 To UBound(arr, 2)
    
35.             s = arr(1, j)
    
36.             If d.exists(s) Then
    
37.                 If j = c1 Then
    
38.                     brr(m, d(s)) = arr(i, j) & arr(i, j + 1)
    
39.                 Else
    
40.                     brr(m, d(s)) = arr(i, j)
    
41.                 End If
    
42.             End If
    
43.         Next
    
44.     Next
    
45.     With sh
    
46.         .UsedRange.Offset(1).Clear
    
47.         With .[a2].Resize(m, col)
    
48.             .Value = brr
    
49.             .Borders.LineStyle = 1
    
50.             .HorizontalAlignment = xlCenter
    
51.             .VerticalAlignment = xlCenter
    
52.         End With
    
53.     End With
    
54.     Application.ScreenUpdating = True
    
55.     Set d = Nothing
    
56.     MsgBox "OK！"
    
57. End Sub
    

复制代码

洋务德雷

lgzxmlg 发表于 2024-3-4 12:11
出现错误提示不知是何原因。

把这个工作簿和要提取的工作簿放到同一个文件夹内。

洋务德雷

lgzxmlg 发表于 2024-3-4 12:11
出现错误提示不知是何原因。

wbFullName = ThisWorkbook.Path & "\工单列表_20240303_094514.xlsx"
工作簿的名字需要根据要提取的工作簿修改。
这里提取的是《工单列表_20240303_094514.xlsx》这个工作簿

lgzxmlg

ykcbf1100 发表于 2024-3-4 13:34
代码已更新。。。

老师谢谢你的帮忙。
但运行后仍然没能提取到工单类型为“马桶维修工单”的“故障描述1”内容。

需要提取的内容
提取后的结果
麻烦老师再看看如何处理。再次感谢。

lgzxmlg

洋务德雷 发表于 2024-3-4 14:08
wbFullName = ThisWorkbook.Path & "\工单列表_20240303_094514.xlsx"
工作簿的名字需要根据要提取的工 ...

老师：将文件放在同一个文件夹下，文件名出相同 仍然出现提示 ，不知什么原因。

洋务德雷

lgzxmlg 发表于 2024-3-4 14:49
老师：将文件放在同一个文件夹下，文件名出相同仍然出现提示，不知什么原因。

原来你的WPS呀，我说呢
对于WPS，我的程序不适用。你的信息里面写的是Office2021。误导了我了。
如果工作中要大量的处理数据的话，建议使用Office，不要使用WPS。

ykcbf1100

lgzxmlg 发表于 2024-3-4 14:41
老师谢谢你的帮忙。
但运行后仍然没能提取到工单类型为“马桶维修工单”的“故障描述1”内容。

明明有的，你为什么睁着眼睛说瞎话呢？

ykcbf1100

附件再上传一次吧。