[問題] vlookup功能應用於VBA
軟體:excel
版本:2010
有多個檔案，其中
B C D B C D
1 甲 10 乙 15
2 乙 20 丁 30
3 丙 30 戊 40
以上，每個檔案會有這種情形要把他抓出來，用VBA處理成
A B C D E
1 甲 乙 丙 丁 戊
2 10 20 30
3 15 30 40
其實我是要把它合併到17320篇的功能裡
不知道可不可行，或是要單獨運算。(儲存格跟原本的不會重複)
Option Explicit
Option Base 1
Sub test()
Dim InBook As Workbook, InSht As Worksheet, InRng As Range
Dim ThisSht As Worksheet, ThisName As String
Dim OutBook As Workbook, OutSht As Worksheet
Dim SelectPath As String
Dim FolderFile As Variant
Dim LC As Byte, MatchCol As Byte, MatchRng As Range
Dim i As Byte, j As Byte, w As Integer
Dim myArr() As String
Set InBook = ThisWorkbook
ThisName = InBook.Name
Set InSht = InBook.Sheets("排放量")
Set MatchRng = [s1:iv1]
MatchRng.EntireColumn.Clear
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then SelectPath = .SelectedItems(1) & "\"
End With
If SelectPath = "" Then Exit Sub
FolderFile = Dir(SelectPath & "*.xls", vbNormal)
Do Until FolderFile = ""
If FolderFile <> ThisName Then
Workbooks.Open SelectPath & FolderFile, , 0
Set OutBook = ActiveWorkbook
Set OutSht = OutBook.Sheets("使用報告書")
OutSht.Select: w = w + 1
If w = 1 Then
[C3:C19].Copy: InSht.Range("S1").PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
[E3:E19].Copy: InSht.Range("S2").PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
w = w + 1
Else
For i = 3 To 19
If Range("C" & i) = "" Then
Exit For
Else
If VarType(Application.Match(Range("C" & i), _
MatchRng, 0)) = vbError Then
LC = InSht.[IV1].End(1)(1, 2).Column
InSht.Cells(1, LC) = Range("C" & i)
InSht.Cells(w, LC) = Range("E" & i)
Else
MatchCol = Application.Match(Range("C" & i),
MatchRng, 0) + 18
InSht.Cells(w, MatchCol) = Cells(i, "E")
End If
End If
Next
End If
OutBook.Close 1
End If
FolderFile = Dir
Loop
End Sub
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 220.140.242.17
※ 編輯: garacias 來自: 220.130.83.178 (02/13 18:24)
→
02/13 18:25, , 1F
02/13 18:25, 1F
Office 近期熱門文章
PTT數位生活區 即時熱門文章
