实例33-表内单元格数据交换，实例34-多个工作表查找替换
实例33-表内单元格数据交换
Private Sub CommandButton处理_Click()
Dim wbname As String
Dim cell1 As String
Dim cell2 As String
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Or .Cells(6, "C").Value <> "" Or .Cells(10, "C").Value <> "" Then
wbname = .Cells(2, "C").Value
cell1 = .Cells(6, "C").Value
cell2 = .Cells(10, "C").Value
Else
MsgBox "请输入工作簿名称（包含扩展名），单元格1地址，单元格2地址"
Exit Sub
End If
End With
With ThisWorkbook.Worksheets("名称列表")
Dim i As Long
Dim imax As Long
Dim shtname As String
imax = .Cells(1000000, 1).End(xlUp).Row
Dim changedata As String
For i = 1 To imax
If .Cells(i, 1).Value <> "" Then
shtname = .Cells(i, 1).Value
With Workbooks(wbname).Worksheets(shtname)
changedata = .Range(cell1)
.Range(cell1) = .Range(cell2)
.Range(cell2) = changedata
End With
End If
Next i
End With
Workbooks(wbname).Save
MsgBox "处理完成"
End Sub
Private Sub CommandButton获取_Click()
'获取工作簿中包含的工作表
With ThisWorkbook.Worksheets("名称列表") '清除原列表数据
.Columns(1).ClearFormats
.Columns(1).ClearContents
End With
Dim wbname As String
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
wbname = .Cells(2, "C").Value
Else
MsgBox "请输入工作簿名称（包含扩展名）"
Exit Sub
End If
End With
Dim i As Integer
For i = 1 To Workbooks(wbname).Worksheets.Count
ThisWorkbook.Worksheets("名称列表").Cells(i, 1).Value = Workbooks(wbname).Worksheets(i).Name
Next i
ThisWorkbook.Worksheets("名称列表").Activate
End Sub
实例34-多个工作表查找替换
Private Sub CommandButton处理_Click()
Dim wbname As String
Dim findrange As String
Dim finddata As String
Dim replacedata As String
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Or .Cells(6, "C").Value <> "" Or .Cells(10, "C").Value <> "" Or .Cells(14, "C").Value <> "" Then
wbname = .Cells(2, "C").Value
findrange = .Cells(6, "C").Value
finddata = .Cells(10, "C").Value
replacedata = .Cells(14, "C").Value
Else
MsgBox "请输入工作簿名称（包含扩展名），查找区域，查找值，替换值"
Exit Sub
End If
End With
With ThisWorkbook.Worksheets("名称列表")
Dim i As Long
Dim imax As Long
Dim shtname As String
imax = .Cells(1000000, 1).End(xlUp).Row
Dim changedata As String
For i = 1 To imax
If .Cells(i, 1).Value <> "" Then
shtname = .Cells(i, 1).Value
With Workbooks(wbname).Worksheets(shtname)
Dim cellitem
For Each cellitem In .Range(findrange)
If cellitem.Value <> "" And cellitem.Value = finddata Then
.Range(cellitem.Address).Value = replacedata
End If
Next
End With
End If
Next i
End With
Workbooks(wbname).Save
MsgBox "处理完成"
End Sub
Private Sub CommandButton获取_Click()
'获取工作簿中包含的工作表
With ThisWorkbook.Worksheets("名称列表") '清除原列表数据
.Columns(1).ClearFormats
.Columns(1).ClearContents
End With
Dim wbname As String
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
wbname = .Cells(2, "C").Value
Else
MsgBox "请输入工作簿名称（包含扩展名）"
Exit Sub
End If
End With
Dim i As Integer
For i = 1 To Workbooks(wbname).Worksheets.Count
ThisWorkbook.Worksheets("名称列表").Cells(i, 1).Value = Workbooks(wbname).Worksheets(i).Name
Next i
ThisWorkbook.Worksheets("名称列表").Activate
End Sub
