我在增强代码以删除“SELECT”选项并使用 ASSIGNMENT 时遇到了困难。这意味着从 SELECT、COPY 和 PASTE 更改为直接分配值。我是一个绝对的初学者,如果有人能指导我的话。我的主要问题在于循环,但是,这是完整的代码,欢迎任何建议、推荐,只是为了让它更有效率!
这是我的代码:
Sub LINK_ANALYSIS()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim NumberOfColumns As Integer
Dim rng As Range
NumberOfColumns = ActiveSheet.UsedRange.Columns.Count
Sheets("Sheet2").Range("A1").Value2 = Sheets("Sheet1").Range("A1").Value2
Sheets("Sheet2").Range("A2:B2").Value2 = "SUBJECT"
Let x = 4
Do While x <= NumberOfColumns
ActiveSheet.UsedRange.AutoFilter Field:=x, Criteria1:="1", Criteria2:="2", Operator:=xlOr
ActiveSheet.UsedRange.Cells(2, x).Select
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
rng.SpecialCells(xlCellTypeVisible).Cells(1).Select
If ActiveCell.Value >= "1" Then
Cells(1, (x - 1)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("A1").Select
End If
ActiveSheet.UsedRange.AutoFilter Field:=x
x = x + 2
Loop
Sheets("Sheet2").Select
ActiveSheet.Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Sheet2").Copy
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub