У меня возникли некоторые проблемы с получением предоставленного кода VBA и было бы признательно за любую помощь.VBA, чтобы удалить всю строку на основе значения ячейки
У меня есть две книги (1) - ежемесячный отчет, который я получаю с несколькими листами, Рабочий лист «host_scan_data» содержит источник информации, с которой мне нужно будет работать. Другая рабочая книга (2) - это где я буду хранить весь консолидированный месяц месяца в месяц.
Как я пытаюсь выполнить эту задачу: 1. запуск рабочей книги # 2 2. Нажмите кнопку, которая имеет следующий VBA код, назначенный (смотри ниже) 3. просматривание и выберите свой ежемесячный отчет (учебное пособие # 1) 4. указать вкладку листа в рабочей книге № 2, где я хотел бы сохранить это обобщение информации 5. запрашивать пользователя проверить вкладку листа, где будут храниться данные
Основываясь на ответах выше макрос затем проанализируйте Столбец K в «host_scan_data« Лист книги (1), и я хотел бы, чтобы он удалял все строки, где Столбец k содержит «0» (обратите внимание, что меня интересуют только 4,3,2,1). Когда это действие будет завершено, я бы хотел, чтобы макрос скопировал сводный список записей в место, указанное на шаге 4 выше.
Я попытался это с несколькими вариациями кода и других решений по всей видимости, работают хорошо, когда «host_scan_data» Лист содержит < 4000 строк, однако, когда я превышает это число (минус) первенствовать перестает отвечать на запросы. В идеале это решение должно обрабатывать около 150 000 строк.
Вот код, я сейчас использую, когда я исполню ее ошибки на «.Sort .Columns (Кл + 1) Заголовок: = xlYes»:
Кодекс У меня есть до сих пор:
Sub Import()
Dim strAnswer
Dim itAnswer As String
Dim OpenFileName As String
Dim wb As Workbook
Dim db As Workbook
Dim Avals As Variant, X As Variant
Dim i As Long, LR As Long
'Optimize Code
Call OptimizeCode_Begin
'Select and Open workbook
OpenFileName = Application.GetOpenFilename("*.xlsx,")
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName, UpdateLinks:=0)
Set db = ThisWorkbook
'Provide Sheet Input
strAnswer = InputBox("Please enter name of worksheet where Nessus data will be imported:", "Import Name")
If strAnswer = "" Then
MsgBox "You must enter a valid name. Exiting now..."
wb.Close
Exit Sub
Else
Response = MsgBox(strAnswer, vbYesNo + vbCritical + vbDefaultButton2, "Is this Correct?")
If Response = vbNo Then
MsgBox "Got it, you made a mistake. Exiting now..."
wb.Close
Exit Sub
Else: MsgBox "Importing Now!"
End If
End If
wb.Sheets("host_scan_data").Activate
Dim rs, cl, Q()
Dim arr1, j, C, s As Long
Dim t As String: t = "4"
Dim u As String: u = "3"
Dim v As String: v = "2"
Dim w As String: w = "1"
If Cells(1) = "" Then Cells(1) = Chr(2)
'Application.Calculation = xlManual
rs = wb.Sheets("host_scan_data").Cells.Find("*", , , , , xlByRows, xlPrevious).Row
cl = wb.Sheets("host_scan_data").Cells.Find("*", , , , , xlByColumns, xlPrevious).Column
ReDim Q(1 To rs, 1 To 1)
arr1 = wb.Sheets("host_scan_data").Cells(1, "k").Resize(rs)
For j = 1 To rs
C = arr1(j, 1)
If (C <> t) * (C <> u) * (C <> v) * (C <> w) Then Q(j, 1) = 1: s = s + 1
Next j
If s > 0 Then
With Cells(1).Resize(rs, cl + 1)
.Columns(cl + 1) = Q
.Sort .Columns(cl + 1), Header:=xlYes
.Cells(cl + 1).Resize(s).EntireRow.Delete
End With
End If
countNum = (Application.CountA(Range("B:B"))) - 1
MsgBox (countNum & " Rows being imported now!")
countNum = countNum + 2
db.Sheets(strAnswer).Range("A3:A" & countNum).value = wb.Sheets("host_scan_data").Range("B3:B" & countNum).value
db.Sheets(strAnswer).Range("B3:B" & countNum).value = wb.Sheets("host_scan_data").Range("K3:K" & countNum).value
db.Sheets(strAnswer).Range("C3:C" & countNum).value = wb.Sheets("host_scan_data").Range("H3:H" & countNum).value
db.Sheets(strAnswer).Range("D3:D" & countNum).value = wb.Sheets("host_scan_data").Range("M3:M" & countNum).value
db.Sheets(strAnswer).Range("E3:E" & countNum).value = wb.Sheets("host_scan_data").Range("L3:L" & countNum).value
db.Sheets(strAnswer).Range("F3:F" & countNum).value = wb.Sheets("host_scan_data").Range("O3:O" & countNum).value
db.Sheets(strAnswer).Range("G3:G" & countNum).value = wb.Sheets("host_scan_data").Range("G3:G" & countNum).value
db.Sheets(strAnswer).Range("K3:K" & countNum).value = wb.Sheets("host_scan_data").Range("X3:X" & countNum).value
MsgBox ("Done")
'Close nessus file
wb.Close SaveChanges:=False
'Else
'MsgBox "You must enter 1 or 2 only. Exiting now..."
'wb.Close
'Exit Sub
'End If
Sheets(strAnswer).Select
'Optimize Code
Call OptimizeCode_End
End Sub
И что ошибка в точности? – litelite
Вместо этого очень длинного вопроса прочитайте [Как спросить] (http://stackoverflow.com/help/how-to-ask) и отредактируйте свой вопрос до минимального объема информации, необходимой для решения проблемы. –
ну, я смущен, но я думаю, что эта строка плохая: – Hrothgar