Excel VBA跳过了许多实例

我有一本6页的工作簿。我正在为每一个人走过它们。任务是： 1） 遍历具有指定范围的每个单元格

2） 如果单元格不为空且仅包含数字，则将其添加到单元格的末尾“ММ”。否则跳过此单元格

但事实上，脚本只对第一张工作表（工作表）有好处。它不会更改其他图纸。我不知道为什么会这样。我认为代码中有一些错误，但我仔细检查了一遍，似乎一切都是正确的。请帮帮我：）

子保存工作表TSASCSV（）
将xWs设置为工作表
作为字符串的Dim xDir
“将文件夹设置为文件”对话框
调光范围
调暗rr As范围
变暗RRRR As范围
暗淡单元格作为范围
k=单元格（Rows.Count，“A”）。结束（xlUp）。行
Set folder=Application.FileDialog（msoFileDialogFolderPicker）
如果folder.Show为-1，则退出子文件夹
xDir=文件夹。选择编辑项（1）
对于Application.ActiveWorkbook.Worksheets中的每个xWs
如果xWs.Name像“工作表”，那么
设置r=范围（“FA2:FA”和k）
对于r中的每个单元格0
如果IsEmpty（cell0.Value）=False，IsNumeric（cell0.Value）=True，则
cell0.Value=cell0.Value&“ММ”
如果结束
下一个
'xWs.Columns（41）.entireclumn.Delete
如果结束
如果xWs.Name像“工作表1”，那么
设置rr=范围（“AG2:AG”&k）
对于rr中的每个单元格1
如果IsEmpty（cell1.Value）=False且IsNumeric（cell1.Value），则
cell1.Value=cell1.Value&“ММ”
如果结束
下一个
'xWs.Columns（126）.entireclumn.Delete
如果结束
如果xWs.Name像“工作表5”，那么
设置RRRR=范围（“FR2:FR”&k）
对于RRRR中的每个单元格5
如果IsEmpty（cell5.Value）=False且IsNumeric（cell5.Value），则
cell5.Value=cell5.Value&“mm”
如果结束
下一个
如果结束
xWs.SaveAs xDir&“\”&xWs.Name，xlCSV，local:=True
下一个
端接头

需要调整这些语句集，以更正图纸参考。当前代码将始终查看活动工作表，且范围参考不合格

Set r=范围（“FA2:FA”&k）

---

Set r=xWs.Range（“FA2:FA”&k）

这些语句集需要调整以正确的图纸参考。当前代码将始终查看活动工作表，且范围参考不合格

Set r=范围（“FA2:FA”&k）

---

设置r=xWs.Range（“FA2:FA”&k）

您可以缩短代码并大量使用代码

首先，您的

k=Cells（Rows.Count，“A”）.End（xlUp）.Row

试图获取最后一行，需要位于Application.ActiveWorkbook.Worksheets中每个xWs的

中，因为每个工作表的最后一行都不同

其次，您可以使用
Select Case
，而不是多个
If
s

第三，范围不需要有3个不同的对象，比如
r
、
rr
、和
rrr
。这同样适用于
cell0
、
cell1
和
cell5
，您可以只使用一个
r
和
cell

在
If
（我的
选择案例
）中，唯一不同的是您设置的
r
范围。其余的，循环通过
r.Cells
对于所有3个标准都是相同的，因此您可以在循环之外使用这一部分，并且只使用一次

修改的代码

Option Explicit

Sub SaveWorksheetsAsCsv()

Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Dim r As Range
Dim cell As Range
Dim k As Long

Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)

For Each xWs In ThisWorkbook.Worksheets ' it's safer to use ThisWorkbook is you reffer to the worksheets inside the workbook which thid code resides
    With xWs
        ' getting the last row needs to be inside the loop
        k = .Cells(.rows.Count, "A").End(xlUp).Row

        Set r = Nothing ' reset Range Object

        Select Case .Name
            Case "Worksheet"
                Set r = .Range("FA2:FA" & k)
                'xWs.Columns(41).EntireColumn.Delete

            Case "Worksheet 1"
                Set r = .Range("AG2:AG" & k)
                'xWs.Columns(126).EntireColumn.Delete

            Case "Worksheet 5"
                Set r = .Range("FR2:FR" & k)

        End Select

        ' check if r is not nothing (it passed one of the 3 Cases in the above select case)
        If Not r Is Nothing Then
            For Each cell In r
                If IsEmpty(cell.Value) = False And IsNumeric(cell.Value) Then
                    cell.Value = cell.Value & " мм"
                End If
            Next cell
        End If

        .SaveAs xDir & "\" & .Name, xlCSV, Local:=True
    End With

Next xWs

End Sub

选项显式
子保存工作表TSASCSV（）
将xWs设置为工作表
作为字符串的Dim xDir
“将文件夹设置为文件”对话框
调光范围
暗淡单元格作为范围
暗k一样长
Set folder=Application.FileDialog（msoFileDialogFolderPicker）
如果folder.Show为-1，则退出子文件夹
xDir=文件夹。选择编辑项（1）
对于此工作簿中的每个xWs.Worksheets'使用此工作簿更安全，因为您可以参照此代码所在工作簿中的工作表
使用xWs
'获取最后一行需要在循环内
k=.Cells（.rows.Count，“A”）.End（xlUp）.Row
设置r=无重置范围对象
选择Case.Name
案例“工作表”
设置r=.Range（“FA2:FA”&k）
'xWs.Columns（41）.entireclumn.Delete
案例“工作表1”
设置r=.Range（“AG2:AG”&k）
'xWs.Columns（126）.entireclumn.Delete
案例“工作表5”
设置r=.Range（“FR2:FR”&k）
结束选择
'检查r是否为nothing（它通过了上述选择案例中的3个案例之一）
如果不是的话，r什么都不是
对于r中的每个单元格
如果IsEmpty（cell.Value）=False且IsNumeric（cell.Value），则
cell.Value=cell.Value&“ММ”
如果结束
下一个细胞
如果结束
.SaveAs xDir&“\”&.Name，xlCSV，Local:=True
以
下一个xWs
端接头
您可以缩短并大量使用您的代码

首先，您的
k=Cells（Rows.Count，“A”）.End（xlUp）.Row
试图获取最后一行，需要位于Application.ActiveWorkbook.Worksheets中每个xWs的
中，因为每个工作表的最后一行都不同

其次，您可以使用
Select Case
，而不是多个
If
s

第三，范围不需要有3个不同的对象，比如
r
、
rr
、和
rrr
。这同样适用于
cell0
、
cell1
和
cell5
，您可以只使用一个
r
和
cell

在
If
（我的
选择案例
）中，唯一不同的是您设置的
r
范围。其余的，循环通过
r.Cells
对于所有3个标准都是相同的，因此您可以在循环之外使用这一部分，并且只使用一次

修改的代码

Option Explicit

Sub SaveWorksheetsAsCsv()

Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Dim r As Range
Dim cell As Range
Dim k As Long

Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)

For Each xWs In ThisWorkbook.Worksheets ' it's safer to use ThisWorkbook is you reffer to the worksheets inside the workbook which thid code resides
    With xWs
        ' getting the last row needs to be inside the loop
        k = .Cells(.rows.Count, "A").End(xlUp).Row

        Set r = Nothing ' reset Range Object

        Select Case .Name
            Case "Worksheet"
                Set r = .Range("FA2:FA" & k)
                'xWs.Columns(41).EntireColumn.Delete

            Case "Worksheet 1"
                Set r = .Range("AG2:AG" & k)
                'xWs.Columns(126).EntireColumn.Delete

            Case "Worksheet 5"
                Set r = .Range("FR2:FR" & k)

        End Select

        ' check if r is not nothing (it passed one of the 3 Cases in the above select case)
        If Not r Is Nothing Then
            For Each cell In r
                If IsEmpty(cell.Value) = False And IsNumeric(cell.Value) Then
                    cell.Value = cell.Value & " мм"
                End If
            Next cell
        End If

        .SaveAs xDir & "\" & .Name, xlCSV, Local:=True
    End With

Next xWs

End Sub

选项显式
子保存工作表TSASCSV（）
将xWs设置为工作表
作为字符串的Dim xDir
将文件夹变暗为Fi