|
参与一下。。。
- Sub ykcbf() '//2025.2.3
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- With Application.FileDialog(msoFileDialogFilePicker)
- .InitialFileName = ThisWorkbook.Path & ""
- .Title = "请选择对应Excel文件"
- .AllowMultiSelect = False
- .Filters.Clear
- .Filters.Add "Excel文件", "*.xls*"
- If .Show Then f = .SelectedItems(1) Else Exit Sub
- End With
- Set wb = Workbooks.Open(f, 0)
- arr = wb.Sheets(1).UsedRange
- wb.Close 0
- For i = 10 To UBound(arr)
- If Val(arr(i, 1)) Then
- s = arr(i, 5)
- d(s) = arr(i, 2)
- End If
- Next
- On Error Resume Next
- With Sheets("物理学科类")
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = .[a1].Resize(r, 16)
- For i = 6 To UBound(arr)
- k = InStr(arr(i, 4), "类")
- If k Then
- arr(i, 16) = Left(arr(i, 4), k)
- Else
- k1 = InStr(arr(i, 4), "(")
- If k1 Then
- s = Left(arr(i, 4), k1 - 1)
- arr(i, 16) = d(s)
- Else
- arr(i, 16) = d(arr(i, 4))
- End If
- End If
- Next
- .Cells(1, 16).Resize(r, 1) = Application.Index(arr, 0, 16)
- End With
- Set d = Nothing
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|