使用Excel从选定的单元格中抓取日期

jslywgbw 于 7个月前发布在其他

关注(0)|答案(2)|浏览(46)

我想在一个特定的文件夹中循环Excel文件。打开一个文件后，宏转到一个指定的选项卡，从四个单元格（比如A2; B3; C5和D 6，我命名为Region，DateSales，Sales和Salesman）复制数据到主文件。
我找到了密码。

Sub getDataFromWbs()

    Dim wb As Workbook, ws As Worksheet
    Dim Region As String
    Dim DateSales As Date
    Dim Sales As Integer
    Dim Salesman As String

    Application.ScreenUpdating = False

    Set fso = CreateObject("Scripting.FileSystemObject")

    'Path to the folder
    Set fldr = fso.GetFolder("C:\Users\xxxxx\yyyyyy\Desktop\Sales\")

    'Next available row in Master Workbook
    y = ThisWorkbook.Sheets("Sheet1").Cells(rows.Count, 1).End(xlUp).Row + 1

    'Loop through each file in that folder
    For Each wbFile In fldr.files

        'Make sure looping only through files ending in .xlsx (Excel files)
        If fso.GetExtensionName(wbFile.Name) = "xlsx" Then

            'Open current book
            Set wb = Workbooks.Open(wbFile.Path)

            Region = Sheets(1).Cells(1, 2).Value
            DateSales = Sheets(1).Cells(2, 3).Value
            Sales = Sheets(1).Cells(3, 5).Value
            Salesman = Sheets(1).Cells(4, 6).Value

            'Loop through each sheet (ws)
            For Each ws In wb.Sheets

                'Last row in that sheet (ws)
                wsLR = ws.Cells(rows.Count, 1).End(xlUp).Row

                'Loop through each record (row 2 through last row)
                For x = 2 To wsLR
                
                'Put column 1,2,3 and 4 of current sheet (ws) into row y of master sheet, then increase row y to next row
                    ThisWorkbook.Sheets("Sheet1").Cells(y, 1) = ws.Cells(x, 1).Value = Region 'col 1
                    ThisWorkbook.Sheets("Sheet1").Cells(y, 2) = ws.Cells(x, 2).Value = DateSales
                    ThisWorkbook.Sheets("Sheet1").Cells(y, 3) = ws.Cells(x, 3).Value = Sales
                    ThisWorkbook.Sheets("Sheet1").Cells(y, 4) = ws.Cells(x, 4).Value = Salesman

                    y = y + 1
                Next x

            Next ws

            'Close current book
            wb.Close

        End If

    Next wbFile

End Sub

字符串
最终结果是主文件中的“否”和“真”值。

excel

来源：https://stackoverflow.com/questions/75460655/looping-through-a-folder-with-excel-files-scraping-date-from-selected-cells-usin

2条答案

按热度按时间

bxfogqkk1#

从关闭的工作簿导入单元格值（FSO）

Option Explicit

Sub ImportData()

    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")

    Dim fsoFolder As Object
    Set fsoFolder = fso.GetFolder("C:\Users\xxxxx\yyyyyy\Desktop\Sales\")

    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1")
    Dim dRow As Long: dRow = dws.Cells(dws.Rows.Count, "A").End(xlUp).Row ' last

    Application.ScreenUpdating = False

    Dim swb As Workbook, sws As Worksheet, fsoFile As Object, sPath As String

    For Each fsoFile In fsoFolder.Files
        
        sPath = fsoFile.Path
        
        If StrComp(fso.GetExtensionName(sPath), "xlsx", vbTextCompare) = 0 Then
            
            Set swb = Workbooks.Open(sPath)
            Set sws = swb.Worksheets(1)
            
            dRow = dRow + 1 ' next
            
            dws.Cells(dRow, "A").Value = sws.Range("A2").Value
            dws.Cells(dRow, "B").Value = sws.Range("B3").Value
            dws.Cells(dRow, "C").Value = sws.Range("C5").Value
            dws.Cells(dRow, "D").Value = sws.Range("D6").Value
            
            swb.Close SaveChanges:=False ' only read from
        
        End If
    
    Next fsoFile

    Application.ScreenUpdating = True

    MsgBox "Data imported.", vbInformation

End Sub

字符串

赞(0）回复(0）举报 7个月前

b4lqfgs42#

正如注解中提到的，您将比较结果写入单元格值。这将是TRUE或TRUE，这就是您看到的结果。要复制实际数据，请尝试更改以下四行代码：

ThisWorkbook.Sheets(1).Cells(y, 1) = ws.Cells(x, 1).Value ' Region
    ThisWorkbook.Sheets(1).Cells(y, 2) = ws.Cells(x, 2).Value ' DateSales
    ThisWorkbook.Sheets(1).Cells(y, 3) = ws.Cells(x, 3).Value ' Sales
    ThisWorkbook.Sheets(1).Cells(y, 4) = ws.Cells(x, 4).Value ' Salesman

字符串

赞(0）回复(0）举报 7个月前

我来回答

使用Excel从选定的单元格中抓取日期

2条答案

从关闭的工作簿导入单元格值（FSO）

相关问题

热门标签

最新问答