求助大神for循环i=1 to n,当n=1，怎么办？

晴朗的

闻启学 发表于 2020-3-5 12:01
楼主  你数字怎样来的  1.1 ----1.？？

  2.1-- 2.？？

根据工作表名称为1，或工作表名称为2的B列的数量确定的

sj15627581616

Sub 批量创建指定模板工作表()
Application.ScreenUpdating = False
r = Cells(Rows.Count, 1).End(3).Row
If r <> 1 Then
arr = Range(Cells(5, 2), Cells(r, 2))
Else
arr = Range("b5")
End If
t = ActiveSheet.Name
If ActiveSheet.Name = "汇总" Then
   For i = 1 To r - 4
    ActiveWindow.SelectedSheets.Copy after:=ActiveSheet
    ActiveSheet.Name = i
    If i <> 1 Then
    Range("a2") = "名称：" & arr(i, 1)
    Else
    Range("a2") = "名称：" & arr
    End If
    Range("a5:p9999") = ""
    Next
    Else
    For i = 1 To r - 4
    ActiveWindow.SelectedSheets.Copy after:=ActiveSheet
    ActiveSheet.Name = t & "." & i
    If i <> 1 Then
    Range("a2") = "名称：" & t & "." & i & "、" & arr(i, 1)
    Else
    Range("a2") = "名称：" & t & "." & i & "、" & arr
     End If
    Range("a5:p9999") = ""
    Next
    End If
    Application.ScreenUpdating = True
End Sub



楼主大概要的是这个意思吧，具体的细节楼主可以摸索进行修改

晴朗的

sj15627581616 发表于 2020-3-5 04:19
楼主的代码建议用With语句简化一下

Sub 编号3()
Dim arr, rng As Range, i&, str As String, j&, m, n, x, k As Integer
Dim jy As String
  n = ActiveSheet.[a5].End(xlDown).Row
  If n = 5 Then
    jy = Cells(5, "b")
  Worksheets(ActiveSheet.Index + i).Name = "1"
   Worksheets(ActiveSheet.Index + i).[A2] = "名称：" & "、" & jy   
   ElseIf n <> 5 Then   
  For x = 5 To n
  arr = ActiveSheet.Range(ActiveSheet.Cells(5, "b"), ActiveSheet.Cells(n, "b"))
  Next x
m = ActiveSheet.Name

For i = 1 To n - 4
With Worksheets(ActiveSheet.Index + i)

If m = "汇总" Then
.Name = Format(i, "0")
.[A2] = "名称：" & Format(i, "0") & "、" & arr(i, 1)
  ElseIf m = "汇总表" Then
.Name = Format(i, "0")
.[A2] = "名称：" & Format(i, "0") & "、" & arr(i, 1)
  ElseIf m <> "汇总" Then
  .[A2] = "名称：" & m & "." & Format(i, "0") & "、" & arr(i, 1)
.Name = m & "." & Format(i, "0")
End If
  End With
   Next i   
   End If
  k = 4
For j = ActiveSheet.Index + 1 To ActiveSheet.Index + n - 4
  k = k + 1
   str = "含税总计"
    Set rng = Worksheets(j).Cells.Find(str, lookat:=xlWhole)
     Worksheets(ActiveSheet.Index).Range("G" & k).Formula = "=" & Worksheets(j).Name & "!" & Range(rng.Address).Offset(0, 5).Address(0, 0)
     Worksheets(ActiveSheet.Index).Range("L" & k).Formula = "=" & Worksheets(j).Name & "!" & Range(rng.Address).Offset(0, 10).Address(0, 0)
     Range("n5") = "=ROUND((G5-L5),0)"
     Range(ActiveSheet.Cells(5, "n"), ActiveSheet.Cells(n, "n")).FillDown
     Next j
End Sub
老师，下级表只有一个时候，我这就运行不了呢？哪出问题了呢？谢谢

lsdongjh

1. Sub 编号()
   
2.     Dim shActive As Worksheet, sh As Worksheet, lngIndex As Long, strName As String
   
3.     Dim arr As Variant, lngRow As Long, rg As Range, lngID As Long
   
4.    
   
5.     Set shActive = ActiveSheet
   
6.     lngIndex = shActive.Index
   
7.     strName = shActive.Name
   
8.    
   
9.     lngRow = shActive.Range("A" & Rows.Count).End(xlUp).Row
   
10.     If lngRow < 5 Then Exit Sub
    
11.    
    
12.     arr = shActive.Range("B5:B" & lngRow)
    
13.    
    
14.     For lngRow = LBound(arr) To UBound(arr)
    
15.         lngID = lngIndex + lngRow
    
16.         If lngID <= Sheets.Count Then
    
17.             Set sh = Sheets(lngID)
    
18.             Set rg = sh.Range("A2")
    
19.             Select Case strName
    
20.                 Case "汇总"
    
21.                     sh.Name = lngRow
    
22.                     rg.Value = "名称：" & lngRow & "、" & arr(lngRow, 1)
    
23.                 Case "1", "2", "3", "4", "6", "7", "8", "9", "10"
    
24.                     sh.Name = strName & "." & lngRow
    
25.                     rg.Value = "名称：" & lngRow & "、" & arr(lngRow, 1)
    
26.                 Case Else
    
27.                     sh.Name = "1." & lngRow
    
28.             End Select
    
29.         End If
    
30.     Next
    
31. End Sub

复制代码

晴朗的

lsdongjh 发表于 2020-3-5 17:49

非常感谢老师的帮助！还有一个小小的问题，如果下级表只有一张表，即lngrow=5,运行就出现问题，劳烦老师帮我看看呗

renkangjizhen

问题解决了！请看附件

renkangjizhen

思路：首先找到带有数字的工作表名称，然后在下一个工作表开始循环，改变工作表名称
直到出现下一个带有数字的工作表名称后，重新循环

晴朗的

renkangjizhen 发表于 2020-3-6 14:48
问题解决了！请看附件

兄弟，您代码放里了吗？

renkangjizhen

带了！而且经过试验了！

晴朗的

renkangjizhen 发表于 2020-3-7 13:55
带了！而且经过试验了！

能受累再传一下吗？我下载了好几遍了 ，里面没有代码呢