VBA:跨多个工作表的列中的唯一项 [英] VBA: Unique items in a column across several worksheets
问题描述
因此,我有一列,即费用",其中包含要声明的费用的名称.我每个月都有这样的列表,每个月都是单独的工作表.目的是在新工作表中获得唯一费用名称的列表,该表稍后将用于总计计算.
So I have a column, say Expenses, which contains the name of an expense being claimed. I have such a list for each month, each month being a separate sheet. The goal is to get a list of unique expense names into a new sheet, which will later be used for totals calculations.
由于我想比较不同的期间,因此要检查的月份(工作表)的数量是可变的,列出的项目数也是可变的,所以我想尽量保持灵活性.
Because I'd like to compare different periods, the amount of months (worksheets) to examine is variable, as is the number of items listed, so I'd like to keep this as flexible as possible.
到目前为止,我已经有了这段代码,但似乎只是崩溃了.我猜测这与某些不包含值的工作表有关,但我不确定.
I have this code so far, but it only seems to crash. I'm guessing it has to do with some sheets not holding values, but I'm not sure.
Sub FindExpenses()
Dim ws As Worksheet
Dim ExpenseNames As New Collection
' Find for each sheet (month)
For Each ws In ActiveWorkbook.Worksheets
Dim itm
Dim i As Long
Dim CellVal As Variant
' Go through each row of column F looking for uniques
For i = 2 To Rows.Count
On Error Resume Next
CellVal = ws.Range("F" & i).Value
On Error Resume Next
ExpenseNames.Add CellVal, Chr(34) & CellVal & Chr(34)
On Error GoTo 0
Next i
Next
' Print out to separate sheet (figure out how to)
For Each itm In ExpenseNames
Debug.Print itm
Next
End Sub
能否请我在几个工作表中的列中标识唯一项,然后将其发送到另一张表中它自己的列中?任何帮助将不胜感激.预先谢谢你!
Could you please help me identify unique items in a column across several worksheets to then send it to it's own column in another sheet? Any help would be greatly appreciated. Thank you in advance!
推荐答案
Excel冻结,因为您在代码中使用了Rows.Count
.因此,对于工作簿中的每个工作表,它最多循环到1048576
.尝试获取最后使用的行并循环到该行.
Excel freezes, because you are using Rows.Count
in your code. Thus, it loops up to 1048576
for every worksheet in your workbook. Try to get the last used row and to loop up to it.
这是一种检查工作表ws
中列F
中最后使用的行的方法:
This is a way to check the last used row in column F
in worksheet ws
:
lastRow (ws.Name, 6)
Function lastRow(Optional strSheet As String, Optional columnToCheck As Long = 1) As Long
Dim shSheet As Worksheet
If strSheet = vbNullString Then
Set shSheet = ActiveSheet
Else
Set shSheet = Worksheets(strSheet)
End If
lastRow = shSheet.Cells(shSheet.Rows.Count, columnToCheck).End(xlUp).Row
End Function
这篇关于VBA:跨多个工作表的列中的唯一项的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!