VBA Excel-宏范围语法问题

Question

所以我一直在努力让这个电子表格正常工作。基本上，我是按技术人员的名字(H栏(对我的数据进行预分类。然后我想把他们分配的每一台设备都复制到带有他们名字的单独工作表中。我似乎搞不清复制行的范围语法。我有两个柜台在运行。计数器不断比较每一行，TechCount移动我的复制范围的起点。我是一个完全的新手，所以我相信有一种更有效的方法可以做到这一点。

示例：数据集

'Create individual Worksheets for Techs with Primary & Secondary Assignments
Dim ws As Worksheet
Dim TechNm As String
Dim wsNM As String
Dim counter As Integer
Dim TechCount As Integer

ActiveWorkbook.Worksheets("DATA SET").Select
TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Value
counter = 0
TechCount = 0

Do
If IsEmpty(Range("H2").Value) = True Then
Exit Do
End If
If TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
counter = counter + 1
ElseIf TechNm <> ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
'Create Worksheet with Tech Name
wsNM = ActiveWorkbook.Sheets("DATA SET").Range("H2")
Set ws = ActiveWorkbook.Sheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
ws.Name = wsNM
'Copy Header Row to new worksheet
ActiveWorkbook.Sheets("DATA SET").Rows(1).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A1")
'Move Tech assignments to new sheet 
**ActiveWorkbook.Sheets("DATA SET").Range("A" & TechCount & ":A" & counter).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A2")**
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit
End With
Rows(1).EntireColumn.AutoFilter
Range("A2").Select
Application.CutCopyMode = False
'Change Do Loop Parameters
ActiveWorkbook.Worksheets("DATA SET").Select
counter = counter + 1
TechCount = counter
TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter, 0).Value

End If
Loop

ActiveWorkbook.Worksheets("TECH ASSIGNMENTS").Select
End Sub

Answer 1

避免选择和使用变量。

Sub test()
'Create individual Worksheets for Techs with Primary & Secondary Assignments
Dim Ws As Worksheet, myWs As Worksheet
Dim TechNm As String
Dim wsNM As String
Dim counter As Integer
Dim TechCount As Integer
Dim Wb As Workbook
'ActiveWorkbook.Worksheets("DATA SET").Select
Set Wb = ActiveWorkbook
Set myWs = Wb.Worksheets("DATA SET")
'TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Value
TechNm = myWs.Range("H2").Value
counter = 0
TechCount = 0

Do
With myWs
'If IsEmpty(Range("H2").Value) = True Then
If IsEmpty(.Range("H2").Value) = True Then
Exit Do
End If
'If TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
If TechNm = .Range("H2").Offset(counter + 1, 0).Value Then
counter = counter + 1
'ElseIf TechNm <> ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
ElseIf TechNm <> .Range("H2").Offset(counter + 1, 0).Value Then
'Create Worksheet with Tech Name
wsNM = .Range("H2")
Set Ws = Wb.Sheets.Add(after:=Wb.Sheets(Wb.Sheets.Count))
Ws.Name = wsNM
'Copy Header Row to new worksheet
'ActiveWorkbook.Sheets("DATA SET").Rows(1).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A1")
.Rows(1).EntireRow.Copy Ws.Range("A1")
'Move Tech assignments to new sheet
**ActiveWorkbook.Sheets("DATA SET").Range("A" & TechCount & ":A" & counter).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A2")**
.Range("A" & TechCount & ":A" & counter).EntireRow.Copy Ws.Range("A2")
With Ws.Cells
'Cells.Select
'With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit

.Rows(1).EntireColumn.AutoFilter
'.Range("A2").Select
Application.CutCopyMode = False
End With
'Change Do Loop Parameters
'ActiveWorkbook.Worksheets("DATA SET").Select
counter = counter + 1
TechCount = counter
TechNm = .Range("H2").Offset(counter, 0).Value
End If
End With
Loop

'ActiveWorkbook.Worksheets("TECH ASSIGNMENTS").Select
Wb.Worksheets("TECH ASSIGNMENTS").Activate
End Sub