|
- Sub text()
- Dim str$, myname$, serchname$
- Dim rng As Range
- Cells.Clear
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- str = ThisWorkbook.Path & "" & "*.xls"
- myname = Dir(str)
- serchname = InputBox("请输入你要合并的城市,比如:合肥,上海等", "系统提醒", "合肥")
- Do While myname <> ""
- If myname <> ThisWorkbook.Name Then
- Workbooks.Open (ThisWorkbook.Path & "" & myname)
- Set rng = ActiveWorkbook.Sheets(1).Rows(2).Find(serchname, lookat:=xlWhole)
- If rng Is Nothing Then
- MsgBox "未找到你选择的城市,汇总失败!"
- Exit Sub
- End If
- If Not rng Is Nothing Then
- rng.EntireColumn.Copy
- ThisWorkbook.Activate
- Sheets(1).Range("A1").Select
- Selection.Insert Shift:=xlToRight
- End If
- Workbooks(myname).Close False
- End If
- myname = Dir
- Loop
- Range("A1:C1").Merge
- [A1] = "4-6月" & serchname & "神秘客得分"
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
复制代码
|
|