vba读取excel文件数据
- 你的回答被采纳后将获得：
- 系统奖励15（财富值+成长值）+难题奖励10（财富值+成长值）+提问者悬赏30（财富值+成长值）
这个很简单,你可以私信我,需要点时间.
你的excel什么版本,我的是2010,
还有个问题"读取某一个指定路径的文件夹下，所有excel文件的sheet1工作表里 （B2-B15）（D2-D9）的数据",共14+8个数据,"写入到当前工作表 的（F12列)和(H12列)",如何排布?
而且读完第一个文件后,再读下一个文件,所得数据放在哪里,放在第一个文件的数据下方吗?如何对齐?
Sub ReMovePackageTypeFromIPS_ForOldFormat()
Dim Str1 As String, Str2 As String, xPath As String, xF() As String, exe As String, xI As Integer, xStart As Integer, xEnd As Integer, temp As String, i As Integer
Dim xLong As Long, xTemp As String
Dim xCup(1 To 22) As String
exe = ActiveWorkbook.Name
xPath = InputBox("Please input the folder you want to have a list:", "Target Folder", "D:\readexcelfile\1\")
If xPath = "" Then Exit Sub
If Right(xPath, 1) <> "\" Then xPath = xPath & "\"
'xPath = "P:\Public\Product development\approved IPS\Automotive\"
Str1 = Dir(xPath, vbHidden + vbSystem)
ReDim Preserve xF(1)
xF(1) = Str1 ' look at me
i = 2
ReDim Preserve xF(2)
If Str1 <> "" Then
Do
Str2 = Dir()
If Str2 <> "" Then
xF(i) = Str2
i = i + 1
ReDim Preserve xF(i)
Else
Exit Do
End If
Loop
End If
'Have a big cycle to write and remove package type
Application.DisplayAlerts = False
For xI = 1 To UBound(xF) - 1
DoEvents
Workbooks.Open xPath & xF(xI), UpdateLinks:=0
'ActiveWorkbook.Sheet1.Activate
For i = 1 To 14
xCup(i) = ActiveWorkbook.ActiveSheet.Cells(i + 1, 2)
Next
For i = 15 To 22
xCup(i) = ActiveWorkbook.ActiveSheet.Cells(i - 13, 4)
Next
Workbooks(xF(xI)).Close (0) ' savechanges:=False
Application.DisplayAlerts = True
Windows(exe).Activate
'ActiveWorkbook.ActiveSheet.Select
xStart = 2
Do Until Cells(xStart, 6) = ""
xStart = xStart + 1
Loop
For i = xStart To xStart + 13
Cells(i, 6) = xCup(i - xStart + 1)
Next
For i = xStart To xStart + 7
Cells(i, 8) = xCup(i - xStart + 14)
Next
Next
End Sub
放在ThisWorkBook代码区
