Я пытаюсь автоматически фильтровать (в столбце A ЛИСТА 1) активную ячейку в ЛИСТ 2 . Затем у меня есть оператор IF, который подсчитывает количество видимых строк, и, если оно больше 1 (исключая заголовок), я хотел бы вставить новую строку в SHEET 3 , вырезать и вставить значения Автофильтрованной строки в SHEET 1 в новую строку в SHEET 3 .
Затем я очищаю Автофильтр в SHEET 1 и вставьте новую строку в SHEET 1 , вырежьте и вставьте значения строки активной ячейки из SHEET 2 в новую строку в SHEET 1 . Если нет результатов автоматического фильтра в ЛИСТЕ 1, то ELSE STATEMENT очищает автоматический фильтр в ЛИСТ 1 , вставляет новую строку в ЛИСТ 1, вырезает и вставляет значения строки активной ячейки из SHEET 2 в новую строку в SHEET 1 .
В настоящее время я не могу заставить свой код работать, если автоматический фильтр приводит к ЛИСТ 2 в любых строках> Строка 2. Вот мой текущий код, который я прокомментировал, чтобы помочь с навигацией:
Sub Autofilter_Macro()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Sheet1
Set sh2 = Sheet2
Set sh3 = Sheet3
Dim rng As Range
Dim AC As Integer
AC = ActiveCell.Row
sh1.AutoFilterMode = False 'Clears any AutoFilters from Sheet1
sh1.Range("A:A").Autofilter Field:=1, Criteria1:=ActiveCell.Value 'AutoFilters SHEET 1 column "A" based off the ActiveCell Row in SHEET 2
Set rng = sh1.UsedRange.SpecialCells(xlCellTypeVisible) 'Sets rng to visible cells
' If (rng.Rows.Count > 1) Then 'Counts the # of visible rows
If rng.Areas.Count = 2 Then
sh3.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
' sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET
rng.Rows(2).Value.Cut sh3.Range("A2")
sh1.ShowallData 'Clears any Autofilters from SHEET 1
sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1
sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
MsgBox "Replaced Main Database" 'MsgBox indicating what has executed
Else
sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1
sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
MsgBox "New Entry into Main Database"
End If
sh1.ShowallData 'Clears any Auotfilters from SHEET 1
End Sub
Спасибо CDP1802 за ответ ниже, вот окончательный код для тех, кто использует это как ссылку:
Sub Autofilter_Macro()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet 'Declares variables as worksheets
Dim rng As Range 'Declares variable as a range to store values
Set sh1 = Sheet1 'Assigns a worksheet to the declared worksheet variable (sh1 = "Main Database" Worksheet = Machine Inv #)
Set sh2 = Sheet2 'Assigns a worksheet to the declared worksheet variable (sh 2 = "Changes" Worksheet)
Set sh3 = Sheet3 'Assigns a worksheet to the declared worksheet variable (sh 3 = "Historical Parameters" Worksheet)
Dim rowAC As Long, rowCut As Long 'Declares variable and assigns it as a Long data type
rowAC = ActiveCell.Row 'Sets the Long variable as the Active Cell Row
If Len(ActiveCell.Value) = 0 Then 'Tests if the Active Cell in column A (Key) of the "Changes" Worksheet is blank or not
MsgBox "Blank Key in:" & ActiveCell.Address, vbCritical 'If the Active Cell is blank, then this MsgBox notifies you that it's blank
Exit Sub 'Ends the entire Macro if the Active Cell is Blank
End If 'Doesn't initiate the MsgBox and continues the Macro if the Key in Column A is not blank
sh1.AutoFilterMode = False 'Clears any Autofilters (if any) in Sheet 1
sh1.Range("A:A").Autofilter Field:=1, Criteria1:=ActiveCell.Value 'Autofilters Sheet 1 for the Active Cell (Key) from Sheet 2 ("Changes" Worksheet)
Set rng = sh1.UsedRange.SpecialCells(xlCellTypeVisible) 'Sets the range varaible to visible cells in Sheet 1 (Main Database)
If rng.Areas(1).Rows.Count > 1 Then 'Tests if the Active Cell (Key) from Sheet 2 (Changes) is in Row 2 of Sheet 1
rowCut = rng.Areas(1).Rows(2).Row 'If the key is present, stores the values of Row 2 in Sheet 1 as a variable called "rowCut"
ElseIf rng.Areas.Count > 1 Then 'Tests if the Active Cell (Key) from Sheet 2 (Changes) is present in any Row of Sheet 1 (Excluding Row 1 "The Header", and Row 2)
rowCut = rng.Areas(2).Rows(1).Row 'If the key is present, stores the values of the row that has the Active Cell "Key" in Sheet 1 as a variable called "rowCut"
End If 'If the Key is not present in Sheet 1, the variable "rowCut" will not hold any values and be equal to zero
sh1.ShowallData 'Clears Autofilters in Sheet 1
If rowCut > 0 Then 'If the variable "rowCut" was succesful in holding a row's values from Sheet 1, then the following executes:
sh3.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row into Sheet 3 Row 2 w/ same format as the row below it
sh1.Rows(rowCut).Copy sh3.Range("A2") 'Copies the Active (Cell) Row from Sheet 1 (Main Database) & pastes it into the empty row 2 in Sheet 3 (Historical Parameters)
sh1.Rows(rowCut).Delete 'Deletes the Active (Cell) Row from Sheet 1
End If 'If the variable "rowCut" was unsuccesful in holding a row's values from Sheet 1, then nothing will happen to Sheet 3 (Historical Parameters)
sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row into Sheet 1 Row 2 w/ same format as the row below it
sh2.Range("A" & rowAC & ":CK" & rowAC).Copy sh1.Range("A2") 'Copies the Active (Cell) Row from Sheet 2 (Changes) & pastes it into the empty row 2 in Sheet 1
sh2.Range("A" & rowAC & ":CK" & rowAC).Delete 'Deletes the Active (Cell) Row from Sheet 2
End Sub