求救！！！VBA按这个条件怎样把excel分成多个表

[weixin_44922293]

就是根据acc那一列(比如E列)把从1到0一张表，接下来的1从1到0再一张表，接下来的也这样，这样连下去，最后弄成很多张表sheet。弄了很久，以为对了，但是一直弄错误。。。。求助各位大神,谢谢啊啊啊啊啊啊啊啊啊！！！

[milaoshu1020]

代码:

Option Explicit

Sub 条件分表()
    Dim intLastACC As Integer
    intLastACC = -1
    
    Dim lngPageStart As Long
    lngPageStart = 2
    
    Dim objSheet As Worksheet
    Set objSheet = ThisWorkbook.Sheets(1)
    
    Dim i As Long
    For i = 2 To objSheet.rows.Count
        If objSheet.Cells(i, 3) = "" Then
            CopyToNewSheet objSheet, lngPageStart, i - 1
            Exit For
        End If
        
        Dim intACC As Integer
        intACC = objSheet.Cells(i, 3)
        
        If intLastACC <> intACC Then
            If intLastACC = 0 And intACC = 1 Then
                CopyToNewSheet objSheet, lngPageStart, i - 1
                lngPageStart = i
            End If
        End If
        
        intLastACC = intACC
    Next
End Sub

Sub CopyToNewSheet(ByVal objSheet As Worksheet, ByVal lngPageStart As Long, ByVal lngPageEnd As Long)
    Dim objSheet2 As Worksheet
    Set objSheet2 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    
    objSheet.Range("A1", "E1").Copy objSheet2.Range("A1")
    objSheet.Range("A" & lngPageStart, "E" & lngPageEnd).Copy objSheet2.Range("A2")
End Sub

运行示例:



下载地址:
链接：https://pan.baidu.com/s/1yqLmb5Z8_avkkQrzR6jXOg
提取码：bep6

[脆皮大雪糕]

设置两个变量分别记录分页起始行和截止行，为了下面简单，假设定义变量名为 b(egin)和e(nd) 都初始化为1 从第1行开始向下逐行处理 如果当前行的acc字段为0，且下一行的acc字段不为0 那么达到分页条件，做以下处理： 1、e=当前行数 2、从 b行到e行的部分拷贝出来到新的sheet 3、b=当前行数+1 e=当前行数+1 继续向下逐行处理直至结束。

[milaoshu1020]

哪两个变量?锁定在F列是什么意思?

[weixin_44922293]

引用 4 楼 milaoshu1020的回复:

哪两个变量?锁定在F列是什么意思?

没事了 是我蠢 看错了 超级感谢！！！！！

[weixin_44922293]

引用 2 楼 milaoshu1020的回复:

代码:

Option Explicit

Sub 条件分表()
    Dim intLastACC As Integer
    intLastACC = -1
    
    Dim lngPageStart As Long
    lngPageStart = 2
    
    Dim objSheet As Worksheet
    Set objSheet = ThisWorkbook.Sheets(1)
    
    Dim i As Long
    For i = 2 To objSheet.rows.Count
        If objSheet.Cells(i, 3) = "" Then
            CopyToNewSheet objSheet, lngPageStart, i - 1
            Exit For
        End If
        
        Dim intACC As Integer
        intACC = objSheet.Cells(i, 3)
        
        If intLastACC <> intACC Then
            If intLastACC = 0 And intACC = 1 Then
                CopyToNewSheet objSheet, lngPageStart, i - 1
                lngPageStart = i
            End If
        End If
        
        intLastACC = intACC
    Next
End Sub

Sub CopyToNewSheet(ByVal objSheet As Worksheet, ByVal lngPageStart As Long, ByVal lngPageEnd As Long)
    Dim objSheet2 As Worksheet
    Set objSheet2 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    
    objSheet.Range("A1", "E1").Copy objSheet2.Range("A1")
    objSheet.Range("A" & lngPageStart, "E" & lngPageEnd).Copy objSheet2.Range("A2")
End Sub

运行示例:



下载地址:
链接：https://pan.baidu.com/s/1yqLmb5Z8_avkkQrzR6jXOg
提取码：bep6

谢谢 不过其他列也有1，0。运行的有点问题 ，请问可以怎样把你定义的两个变量锁定在f列中？