Ошибка времени выполнения макроса

Вопрос:

У меня есть код кода, который фильтрует столбец для нулевых значений и возвращает строку. Я пробовал перебирать разные столбцы. Этот макрос хорошо работает с небольшим вводом.
Но у меня есть лист excel с 160106 рядами. Я хочу запустить макрос. Я получаю сообщение об ошибке 1004. Я нашел следующую ссылку, которая объясняет проблему
http://support.microsoft.com/kb/210684

Но я не могу его разрешить. Может ли кто-нибудь помочь мне. Я вставляю свой макрос ниже

мой файл образца находится в
http://rapidshare.com/files/457005707/data1.xlsx
это файл размером 96 МБ

Option Explicit
Sub findrcn()
Dim wsStart As Worksheet
Dim sWord As String
Dim RowCount As Integer
Dim i As Long
Dim j As Long
Dim l As Long
Dim k As String
Dim Final As Integer
Dim lastrow As Integer
Dim rng As Range
Dim oBook As Workbook





Set wsStart = ActiveSheet
'this loop is to check if a sheet exists
For j = 1 To Worksheets.Count
k = Worksheets(j).Name
If UCase(k) = UCase("Analysis") Then
lastrow = ((Sheets("Analysis").Range("A" & Rows.Count).End(xlUp).Row) + 1)
Else
lastrow = 0
End If

Next j
MsgBox "finished checking the sheets"
i = 1
For Each rng In Range("A1:B1").Columns
sWord = Replace(rng.Address(RowAbsolute:=False), "$", "")   ''Now I am trying to loop over all the columns

If lastrow = 0 Then
Sheets.Add After:=Sheets(Sheets.Count) 'Adding a new sheet
Sheets(Sheets.Count).Name = "Analysis"
wsStart.AutoFilterMode = False

With wsStart
.Range(sWord).AutoFilter Field:=i, Criteria1:="=0" 'if my column contains a 0 in it filter that

With .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
Final = .Count 'get the count of the number of rows after the filter
RowCount = Final - 1
End With

Sheets("Analysis").Range("A") = RowCount 'paste it in the analysis tab
Sheets("Analysis").Range("B") = (Range(sWord))

End With
wsStart.AutoFilterMode = False
MsgBox "Trust in the Lord with all your heart and lean not on your own understanding; In all your ways acknowledge Him, and He will make your paths straight." & vbCrLf & "Proverbs 3:5" & vbCrLf & "                        SUCCESSFULLY     COMPLETED!!!"

Else

wsStart.AutoFilterMode = False

lastrow = ((Sheets("Analysis").Range("A" & Rows.Count).End(xlUp).Row) + 1)
With wsStart
.Range(sWord).AutoFilter Field:=i, Criteria1:="=0" 'if my column contains a 0 in it filter that
With .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
Final = .Count
RowCount = Final - 1 ' to account for column name
End With

Sheets("Analysis").Range("A" & lastrow) = RowCount 'paste it in the analysis tab
Sheets("Analysis").Range("B" & lastrow) = (Range(sWord))

End With
wsStart.AutoFilterMode = False


End If
i = i + 1
Next rng

Ответ №1

Хотя в этой статье базы знаний говорится о копировании листов, и вы копируете ячейки, вы можете следовать ее советам и периодически сохранять и закрывать свои рабочие листы.

Ответ №2

На первый взгляд кажется, что это гораздо более простое решение: используйте функцию CountIf

Например, если ваши данные находятся на Sheet2, на листе анализа введите в ячейку =COUNTIF(Sheet2!A:A,0)
это дает счет ячейки = 0 в столбце A

Если вам нужно это в VBA по другим причинам, вы можете использовать somthing like

Set r = ActiveSheet.Columns("A:A")
z = Application.WorksheetFunction.CountIf(r, "0")

Оцените статью
TechArks.Ru
Добавить комментарий