筛选后一分为二的VBA写法

lanzlive

Option Explicit

Sub or4()
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim shaobing As Integer
Dim rowindex
Dim Mysheet As Workbook
Dim allrow
Dim provstring As String
Dim citystring As String
Dim mayorstring As String
Dim nextmayor As String
Dim lastrow As Long
Dim selectedrange As Range
Dim halfrow As Long

shaobing = 0
rowindex = 1

Set Mysheet = Workbooks.Open("D:\origin.xlsx")

allrow = ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value

For rowindex = 2 To allrow
    provstring = CStr(Mysheet.Sheets("sheet1").Cells(rowindex, 1))
    citystring = CStr(Mysheet.Sheets("sheet1").Cells(rowindex, 2))
    mayorstring = CStr(Mysheet.Sheets("sheet1").Cells(rowindex, 3))
    Mysheet.Sheets("board").Range("f1:i50").Clear
   
    If nextmayor <> mayorstring Then
        nextmayor = mayorstring
        Mysheet.Sheets("sheet1").Range("A1").AutoFilter field:=1, Criteria1:=provstring
        Mysheet.Sheets("sheet1").Range("A2").AutoFilter field:=2, Criteria1:=citystring
        Mysheet.Sheets("sheet1").Range("A3").AutoFilter field:=3, Criteria1:=mayorstring
        lastrow = Mysheet.Sheets("sheet1").Range("d65535").End(xlUp).Row
        Set selectedrange = Mysheet.Sheets("sheet1").Range("a2:d" & lastrow).SpecialCells(xlCellTypeVisible)
        selectedrange.Select
        selectedrange.Copy Mysheet.Sheets("board").Range("f1:i100")
        
        halfrow = selectedrange.Rows.Count / 2
        If halfrow > 0 Then
           Mysheet.Sheets("board").Range("f1:i" & halfrow).Copy Mysheet.Sheets("firsthalf").Cells(shaobing + 1, 1)
           Mysheet.Sheets("board").Range("f" & halfrow & ":i50").Copy Mysheet.Sheets("lasthalf").Cells(shaobing + 1, 1)
           shaobing = shaobing + halfrow
        End If
        Mysheet.Sheets("sheet1").Range("A1").AutoFilter field:=1
        Mysheet.Sheets("sheet1").Range("A2").AutoFilter field:=2
        Mysheet.Sheets("sheet1").Range("A3").AutoFilter field:=3
    End If
DoEvents
Next rowindex

Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

我的代码问题也解决了，加一个判断即可，谢谢各位