gpt4 book ai didi

excel VBA,在将多个 CSV 文件复制到一个工作簿时,在单元格中创建一个包含工作表或文件名的列

转载 作者:行者123 更新时间:2023-12-04 03:39:08 24 4
gpt4 key购买 nike

我有 700 个 CSV 文件,每个文件有 7 列 1000 行,我需要将它们放在一个长列中。示例代码正在执行复制,但我不知道如何让它在复制前在每个单元格中创建一个列(与该文件中其他列的长度相同),其中包含工作表或文件名。我真的只需要每个 CSV 文件中的 A 列(日期)、创建的列(工作表名称)和 F 列(值),如果可能的话,按此顺序排列。

    Sub ImportData()
Dim lastrow As Long
Dim clastrow As Long
Dim filePath As String
Dim fileName As String
Dim count As Long
Dim importRange As Range
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim cws As Excel.Worksheet
count = 0
Set cws = ThisWorkbook.Sheets(2)
filePath = "C:\Users\user\Desktop\CSV files\"
fileName = Dir(filePath & "*.csv")
Do While fileName <> ""
count = count + 1
Set wb = Excel.Workbooks.Open(filePath & fileName)
Set ws = wb.Worksheets(1)
lastrow = ws.Cells(Rows.count, "a").End(xlUp).Row
clastrow = cws.Cells(Rows.count, "a").End(xlUp).Row + 1
Set importRange = ws.Range("a2:f" & lastrow) 'skips header row
' cws.Cells(clastrow, 1).End(xlUp).Offset(1, 0).Resize(importRange.Rows.count, importRange.Columns.count) = importRange.Value
importRange.Copy
cws.Cells(clastrow, "a").PasteSpecial xlPasteValues
wb.Application.CutCopyMode = False
wb.Close
fileName = Dir
Loop
End Sub

最佳答案

通过赋值复制值

  • 未经测试。

代码

Option Explicit

Sub importData()

' Define constants.
Const FilePath As String = "C:\Users\user\Desktop\CSV files\"

' Define Destination First Cell.
Dim drg As Range
With ThisWorkbook.Sheets(2)
Set drg = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With

' Write the first file name to a variable.
Dim FileName As String: FileName = Dir(FilePath & "*.csv")

' Declare additional variables.
Dim srg As Range ' Source Range
Dim sLastRow As Long ' Source Last Row
Dim srCount As Long ' Source Rows Count
Dim fCount As Long ' Files Count

' Copy values by assignment.
Application.ScreenUpdating = False
Do While FileName <> ""
With Workbooks.Open(FilePath & FileName).Worksheets(1)
sLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If sLastRow >= 2 Then
fCount = fCount + 1
Set srg = .Range("A2:F" & sLastRow)
srCount = srg.Rows.Count
Set drg = drg.Resize(srCount)
drg.Value = srg.Columns(1).Value
drg.Offset(, 1).Value = .Name
drg.Offset(, 2).Value = srg.Columns(6).Value
Set drg = drg.Cells(1).Offset(srCount)
End If
.Parent.Close SaveChanges:=False
End With
FileName = Dir
Loop
'drg.Worksheet.Parent.Save
Application.ScreenUpdating = True

' Inform.
MsgBox "Files processed: " & fCount, vbInformation, "Success"

End Sub

关于excel VBA,在将多个 CSV 文件复制到一个工作簿时,在单元格中创建一个包含工作表或文件名的列,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66358513/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com