双循环（循环中的循环）vba excel

我对VBA比较陌生，需要一些帮助才能完全理解一些问题

我有一份有很多工作表的文件，我需要为每个团队制作一份该文件的副本。每个文件不得包含其他团队的信息

我已经成功地汇编了这段代码，它似乎只适用于一张工作表，但并不适用于我需要的每一张工作表

前四张表应该保持不变（这些表中没有过滤），黄色的表与其他表的排列方式不同（我需要稍后再看），但其余的表具有完全相同的结构，因此用于“计算”的列是相同的。（附件中的文件和示例）

Sub-DeleteRowBasedOnCriteria（）
“高球的名字
Dim lob（14）作为字符串
lob（0）=“平均值”
lob（1）=“CA”
lob（2）=“G_13”
lob（3）=“HSTP”
lob（4）=“JLS”
lob（5）=“JR”
lob（6）=“LPV”
lob（7）=“毛”
lob（8）=“NML”
lob（9）=“PRJ”
lob（10）=“RB”
lob（11）=“RG”
lob（12）=“SPN”
lob（13）=“VE”
“柜台
作为整数的Dim i
'行数
昏暗的长椅
'创建要填充的模板副本'
将sFile设置为字符串“源文件-模板”
Dim sDFile作为字符串“目标文件-模板”
将sSFolder设置为字符串“源文件夹-模板”
将文件夹设置为字符串“目标文件夹”
sSFolder=“C:\Users\Pacosta\Desktop\parapersonals\team.xlsx”
MsgBox（SSG文件夹）
'目标路径窗口选择器
Dim destinationWindow作为文件对话框
Set destinationWindow=Application.FileDialog（msoFileDialogFolderPicker）
destinationWindow.Title=“选择目标文件夹”
'仅选择一个文件夹
destinationWindow.AllowMultiSelect=False
如果是destinationWindow，则显示
sDFolder=destinationWindow。选择编辑项（1）+“\”
如果结束
'基于带书签的模板将单元格内容复制到excel文件'
作为对象的Dim objExcel
将ws设置为工作表
对于i=0到14
'创建与lob同名的文件
sDFile=lob（i）+“.xlsx”
“创建对象excel文档”
设置FSO=CreateObject（“Scripting.FileSystemObject”）
'复制模板执行目标'
FSO.CopyFile（sSFolder+sFile），sDFolder+sDFile，True
接下来我
将文件设置为字符串
对于i=0到11
file=sDFolder+lob（i）+“.xlsx”
调用getIndex（lob（i），文件）
接下来我
端接头
'从LOB名称文件中删除不同的行
子删除行（lob作为字符串，文件作为字符串）
'禁用自动计算
Application.Calculation=xlCalculationManual
'计算行数
昏暗的长椅
'变量来处理所有文件
Dim ficheiro作为工作簿
Set ficheiro=工作簿。打开（文件）
带菲希罗表（1）
'删除其他lob的行'
对于rowtotest=.Cells（Rows.Count，7）.End（xlUp）.Row+1到5步骤-1
如果StrComp（.Cells（rowtotest，7）.Value，lob）为0，则
.Rows（rowtost）.删除
如果结束
下一个划手
以
"算计",
应用。计算
“然后记得重新运行自动计算
Application.Calculation=xlCalculationAutomatic
'保存文件
菲切罗，救命
'关闭文件
菲切罗，结束
端接头
子GetIndex（lob作为字符串，文件作为字符串）
'计算行数
昏暗的长椅
印度总理
尺寸指示器1为整数
"印度"
作为整数的Dim指示符2
'变量来处理所有文件
Dim ficheiro作为工作簿
Set ficheiro=工作簿。打开（文件）
带菲希罗表（1）
'删除其他lob的行'
对于rowtotest=.Cells（Rows.Count，8）.End（xlUp）.Row+1到5步骤-1
如果StrComp（.Cells（rowtotest，8）.Value，lob）=0，则
指标2=行测试
rowtotest=0
如果结束
下一个划手
'删除其他lob的行'
对于rowtotest=4到.Cells（Rows.Count，8）。结束（xlUp）。行+1步骤1
如果StrComp（.Cells（rowtotest，8）.Value，lob）=0，则
指标1=行测试
rowtotest=1000
如果结束
下一个划手
将文本变暗为字符串
texto=indicate2&“：”&.Cells（Rows.Count，8）。End（xlUp）。Row+1
.Rows（texto）.删除
texto=5&“：”&表示1
.Rows（texto）.删除
菲切罗，救命
菲切罗，结束
以
端接头

有人能帮我解决这个问题吗？

---

提前谢谢。

忘了把我已经获得的代码放在这里了：你应该在这篇文章中编辑你的代码，而不是放在一张受限的非现场工作表中。另外，您是在Excel中还是在Google Drive中执行此操作？VBA只在Excel中工作。Thaks为了快速回复，我在Excel中工作，只是想展示一下Excel的组织结构。代码编辑看起来像我的语法编辑覆盖了你的代码编辑（不知道为什么它被批准）。再次尝试编辑您的代码。这并不能回答您的问题，但您可以通过将

lob

声明为

Variant

然后使用行

lob=Array（“AV”、“CA”、“G_13”、“HSTP”、“JLS”、“JR”、“LPV”、“MAO”、“NML”、“PRJ”、“RB”、“RG”、“SPN”、“VE”）来稍微缩短代码。

Sub DeleteRowBasedOnCriteria()

'lobs names
Dim lob(14) As String

lob(0) = "AV"
lob(1) = "CA"
lob(2) = "G_13"
lob(3) = "HSTP"
lob(4) = "JLS"
lob(5) = "JR"
lob(6) = "LPV"
lob(7) = "MAO"
lob(8) = "NML"
lob(9) = "PRJ"
lob(10) = "RB"
lob(11) = "RG"
lob(12) = "SPN"
lob(13) = "VE"

'counter
Dim i As Integer

'numbers of rows
Dim rowtotest As Long

' to create a copy of the template to be filled'
Dim sFile As String 'Source file - Template'
Dim sDFile As String 'Destination file - Template'
Dim sSFolder As String 'Source folder  - Template'
Dim sDFolder As String 'Destination Folder'

sSFolder = "C:\Users\Pacosta\Desktop\ParaIndividuals\team.xlsx"

MsgBox (sSFolder)

'Destination Path Window selector
Dim destinationWindow As FileDialog
Set destinationWindow = Application.FileDialog(msoFileDialogFolderPicker)
destinationWindow.Title = "Select Destination Folder"

'only select one folder
destinationWindow.AllowMultiSelect = False
If destinationWindow.Show Then
sDFolder = destinationWindow.SelectedItems(1) + "\"
End If

'copy cell content to excel file based on template with bookmarks'
Dim objExcel As Object
Dim ws As Worksheet

For i = 0 To 14
'create a file with same name as lob
sDFile = lob(i) + ".xlsx"

'Create object excel document'
Set FSO = CreateObject("Scripting.FileSystemObject")

'Copy the template do destination'
FSO.CopyFile (sSFolder + sFile), sDFolder + sDFile, True
Next i

Dim file As String

For i = 0 To 11
file = sDFolder + lob(i) + ".xlsx"
Call GetIndices(lob(i), file)
Next i

 End Sub

'delete rows diferents from lobs namefile
Sub DeleteRows(lob As String, file As String)

'disable automatic calculation
Application.Calculation = xlCalculationManual

'count number of rows
Dim rowtotest As Long

'variable to work with all files
Dim ficheiro As Workbook
Set ficheiro = Workbooks.Open(file)

With ficheiro.Sheets(1)

'delete rows of the other lob's
For rowtotest = .Cells(Rows.Count, 7).End(xlUp).Row + 1 To 5 Step -1
If StrComp(.Cells(rowtotest, 7).Value, lob) <> 0 Then
    .Rows(rowtotest).Delete
End If
Next rowtotest 
End With

' Force a calculation
Application.Calculate

' Then remember to run automatic calculations back on
Application.Calculation = xlCalculationAutomatic

'save file
ficheiro.Save

'close file
ficheiro.Close

End Sub

Sub GetIndices(lob As String, file As String)

'count number of rows
Dim rowtotest As Long

'primeiro indice
 Dim indice1 As Integer

 'segundo indice
Dim indice2 As Integer

'variable to work with all files
Dim ficheiro As Workbook
Set ficheiro = Workbooks.Open(file)

With ficheiro.Sheets(1)

'delete rows of the other lob's
For rowtotest = .Cells(Rows.Count, 8).End(xlUp).Row + 1 To 5 Step -1
  If StrComp(.Cells(rowtotest, 8).Value, lob) = 0 Then
    indice2 = rowtotest
    rowtotest = 0
   End If
Next rowtotest

'delete rows of the other lob's
For rowtotest = 4 To .Cells(Rows.Count, 8).End(xlUp).Row + 1 Step 1
 If StrComp(.Cells(rowtotest, 8).Value, lob) = 0 Then
    indice1 = rowtotest
    rowtotest = 1000
  End If
Next rowtotest

Dim texto As String
texto = indice2 & ":" & .Cells(Rows.Count, 8).End(xlUp).Row + 1
.Rows(texto).Delete

texto = 5 & ":" & indice1
.Rows(texto).Delete

ficheiro.Save
ficheiro.Close

End With

End Sub