从选择更改为值分配

从选择更改为值分配

我在增强代码以删除“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

相关内容