计算Excel行而不打开它

Question

我找到了此代码

Sub test()
Dim i As Integer
Dim j As Integer
Dim mypath As String
Dim filename As String
Dim shtname As String
Dim m As Integer
Dim myfile As Workbook

With ThisWorkbook.ActiveSheet
.Cells.ClearContents
.Range("A1").Value = "filename"
.Range("B1").Value = "sheet's name"
.Range("C1").Value = "rows count"
End With

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
mypath = .SelectedItems(1) & "\"
End With

filename = Dir(mypath & "*.xls")
Do While filename <> ""
Workbooks.Open mypath & filename
i = ActiveWorkbook.Worksheets.Count
m = ThisWorkbook.ActiveSheet.Cells(65536, 1).End(xlUp).Row
For j = 1 To i
With ThisWorkbook.ActiveSheet
.Cells(m + j, 1).Value = filename
.Cells(m + j, 2).Value = ActiveWorkbook.Worksheets(j).Name
.Cells(m + j, 3).Value = ActiveWorkbook.Worksheets(j).Cells(1, 1).End(xlDown).Row
End With
Next j
filename = Dir()
Loop

filename = Dir(mypath & "*.csv")
Do While filename <> ""
Workbooks.Open mypath & filename
m = ThisWorkbook.ActiveSheet.Cells(65536, 1).End(xlUp).Row
With ThisWorkbook.ActiveSheet
.Cells(m + 1, 1).Value = filename
.Cells(m + 1, 3).Value = ActiveWorkbook.ActiveSheet.Cells(1, 1).End(xlDown).Row
End With
filename = Dir()
Loop

For Each myfile In Workbooks
If myfile.Name <> ThisWorkbook.Name Then
myfile.Close False
End If
Next

End Sub

from chandoo.org它不打开就计算Excel的行数，唯一的问题是它计算“第一列”，但是我想计算Excel文件中的“列”（PC） 因此，任何人都可以使用Excel宏修改此代码以计算列（PC）而不是第一列

预先感谢

Answer 1

在列行数中

我对您的代码做了一些改进。

开始时，您必须调整 3个重要常量：

  

  
• cVntColumn -这是要对行进行计数的列。您可以使用列字母（带引号，例如“ PC” ）或数字（不带引号，例如 419 ）。
    您当前最喜欢的列是 PC ，所以我就是这么做的。
  
• cIntHeaderRow -标题行号通常是带有标题的第一行。您可能不想统计这一行，所以在这里您进行更改   从0到所需的值。您可以有不连续的数据（数据   单元格为空），因为该程序从下面找到最后一行。
  
• cBlnHidden -启用后，此功能将删除隐藏的工作簿。那就是我发生的事情。我有一个隐藏的工作簿   总是用各种功能，工具栏等打开。当我运行时   在原始程序中，隐藏的工作簿已关闭。你应该   可能会像我正在使用时将其保留为False。
  

---

  

注意：您必须意识到该程序可以打开工作簿，并且在   每个打开的工作簿的工作表都会计算最后使用的行，并将数据写入   该工作簿的 ActiveSheet ，然后关闭除该工作簿以外的所有工作簿。

---

Sub IncolumnRowsCount()

  Const cVntColumn As Variant = "PC"    ' Count-rows Column Letter/Number
  Const cIntHeaderRow As Integer = 0    ' Header Row Number
  Const cBlnHidden As Boolean = False   ' Enable Close Hidden Workbooks

  ' String Lists
  Const cStrAddresses As String = "A1,B1,C1"
  Const cStrHeaders As String = "FileName,SheetName,Rows"
  Const cStrExtensions As String = "*.xls*,*.csv"
  Const cStrNoWorksheet As String = "*.csv"

  Dim vntAddresses As Variant     ' Addresses Array
  Dim vntHeaders As Variant       ' Headers Array
  Dim vntExt As Variant           ' Extensions Array
  Dim vntNoSheet As Variant       ' No Worksheet Array

  Dim strFolderPath As String     ' Search Folder
  Dim strFileName As String       ' Current File Name (Workbook)
  Dim strWsName As String         ' Current Worksheet
  Dim intSrcCount As Integer      ' Workbooks Count
  Dim intSrcExt As Integer        ' Source File Extensions Counter
  Dim intSrcIndex As Integer      ' Source Worksheets Index
  Dim intSrcNoSheet As Integer    ' Source No Sheet Counter
  Dim lngTgtRow As Long           ' Target Last Row

  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With

  On Error GoTo ProcedureExit

  ' Copy String Lists into arrays.
  vntAddresses = Split(cStrAddresses, ",")
  vntHeaders = Split(cStrHeaders, ",")
  vntExt = Split(cStrExtensions, ",")
  vntNoSheet = Split(cStrExtensions, ",")

  With ThisWorkbook.ActiveSheet   ' The rest of the code is 'under its wings'.

    ' Prepare Target Worksheet
    .Cells.ClearContents
    For intSrcCount = 0 To UBound(vntAddresses)
      .Range(vntAddresses(intSrcCount)).Value = vntHeaders(intSrcCount)
    Next

    ' Choose Search Folder
    With Application.FileDialog(msoFileDialogFolderPicker)
      If .Show = False Then Exit Sub
      strFolderPath = .SelectedItems(1) & "\"
    End With

    ' Loop through extensions.
    For intSrcExt = 0 To UBound(vntExt)

      ' Loop through folder to determine Current File Name (Workbook).
      strFileName = Dir(strFolderPath & vntExt(intSrcExt))

      ' Loop through files in folder.
      Do While strFileName <> ""

        ' Open each file in folder
        Workbooks.Open strFolderPath & strFileName

        ' Calculate last used row of Target Worksheet.
        lngTgtRow = .Cells(.Rows.Count, _
            .Range(Trim(vntAddresses(0))).Column).End(xlUp).Row

        For intSrcIndex = 1 To ActiveWorkbook.Worksheets.Count

          ' Write current workbook name to Target Worksheet
          .Cells(lngTgtRow + intSrcIndex, _
              .Range(Trim(vntAddresses(0))).Column).Value = strFileName

          ' If no worksheet (e.g. .csv)
          For intSrcNoSheet = 0 To UBound(vntNoSheet)
            If Trim(vntNoSheet(intSrcNoSheet) = Trim(vntExt(intSrcExt))) _
                Then Exit For
          Next
          ' Write worksheet name to Target Worksheet
          If intSrcNoSheet = UBound(vntNoSheet) + 1 Then .Cells(lngTgtRow + _
              intSrcIndex, .Range(Trim(vntAddresses(1))).Column).Value _
              = ActiveWorkbook.Worksheets(intSrcIndex).Name

          ' Write the number of records to Target Worksheet. If cIntHeaderRow
          ' is equal to 0, it is also the last used row in Count-row Column.
          .Cells(lngTgtRow + intSrcIndex, _
              .Range(Trim(vntAddresses(2))).Column).Value _
              = ActiveWorkbook.Worksheets(intSrcIndex) _
              .Cells(Rows.Count, cVntColumn).End(xlUp).Row - cIntHeaderRow
        Next

        strFileName = Dir()
        ' Exclude this workbook.
        If .Parent.Name = strFileName Then strFileName = Dir()

      Loop

    Next

    ' Formatting
    .Columns.AutoFit

    ' Close all open workbooks except this one.
    For intSrcCount = Workbooks.Count To 1 Step -1
      If cBlnHidden Then
        If Workbooks(intSrcCount).Name <> .Parent.Name Then
          Workbooks(intSrcCount).Close False
        End If
       Else
        If Workbooks(intSrcCount).Name <> .Parent.Name And _
          Workbooks(intSrcCount).Windows(1).Visible Then
          Workbooks(intSrcCount).Close False
        End If
      End If
    Next

'     ' ... instead of:
'    Dim objWb As Workbook
'      For Each objWb In Workbooks
'        If objWb.Name <> .Parent.Name Then
'          objWb.Close False
'        End If
'      Next
'    Set objWb = Nothing

  End With

ProcedureExit:

  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
  End With

End Sub

---

如果对此代码还有其他疑问，请随时发表评论。

Answer 2

我想知道您是说Column PC是419列吗？

如果是这种情况，则可以更改使用第1列查找最后一行的任何适用位置，以使用第419列或“ PC”

例如

此

m = ThisWorkbook.ActiveSheet.Cells(65536, 1).End(xlUp).Row

成为：

With ActiveSheet
        m = .Cells(.Rows.Count, "PC").End(xlUp).Row
End With