Question

新人请教各路大神一个关于excel VBA的问题，跪求给予帮助，该怎么改才能实现，谢谢。

想做一个宏，导入excel表数据批处理的，但是提示下面第一个标注的那一行
：类型不匹配，把这几句注释掉以后，又提示第二个标注的那一行：类型不匹配。代码如下：跪求大神指点迷津！
Sub 批处理()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
workbookname = ActiveWorkbook.Name()
CellFilename = Application.GetOpenFilename("xls Files(*.xls),*.xls", , "请选择打开需要处理的指标文件！", , True)
'If CellFilename = False Then ----这一行提示类型不匹配
'Exit Sub
'End If
Workbooks(workbookname).Sheets(1).Cells(2, 1) = Left(CellFilename, InStrRev(CellFilename, "\")) ----这一行提示类型不匹配
For m = 1 To 9
If CellFilename <> "" Then
Workbooks.OpenText Filename:=CellFilename

If CellFilename = "*6000*" Or CellFilename = "*6900*" Then
【一段处理过程a】
Else
【一段处理过程b】
End If
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "数据整理完毕！"
End Sub

Answer 1

'If CellFilename = False Then ----这一行提示类型不匹配, cellfilename的类型是字符串不是boolean类型的值，当然会报错了！
哥们是做HW设备的网优的吧 ！！1
给你一段代码仅供参考
Dim tempv As Integer
Dim sheetname As String
existflag = False
falsenum = 0
i = 1
Application.DisplayAlerts = False
Application.CutCopyMode = False
Application.DisplayAlerts = False
'Application.ScreenUpdating = False
MsgBox ("请输入要合并的sheet名字")
sheetname = InputBox("输入要合并的sheetname！")
If sheetname = "" Then
MsgBox "输入的sheet名字不合法！！"
Exit Sub
End If
inputfilename = Application.GetOpenFilename("EXCEL文件(*.xls;*.xlsx;*.csv), *.txt;*.xlsx;*.csv", , , , True) '打开支持2003，2007，.CSV文件
If Not IsArray(inputfilename) Then Exit Sub '如果没有选中相关工作簿，退出程序
filenum = UBound(inputfilename)
Debug.Print (filenum)
tm = Timer
For openfilenum = 1 To filenum
excelfilename = CStr(dealfilename(inputfilename(openfilenum)))
Workbooks.Open (excelfilename)
existflag = SheetsExist(sheetname)
'Debug.Print ("exist=" & existflag)

If (existflag) Then
Debug.Print (existflag)
Worksheets(sheetname).Activate

Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select
Selection.Copy
ThisWorkbook.Worksheets("合并后数据").Activate

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'ThisWorkbook.Worksheets("合并后数据").Cells(ThisWorkbook.Worksheets("合并后数据").UsedRange.Rows(Column(1)).Count + 2, 1).Activate
While Not Cells(i, 1) = ""
i = i + 1
Wend
ThisWorkbook.Worksheets("合并后数据").Cells(i, 1).Activate
ActiveCell.PasteSpecial
Windows(excelfilename).Activate
ActiveWindow.Close
Application.StatusBar = "正在处理 " & excelfilename & " 请耐心等待！！！ 正在处理第" & openfilenum & "个文件！"

Else
Windows(excelfilename).Activate
ActiveWindow.Close
falsenum = falsenum + 1
End If
Next
'Workbooks.Open (excelfilename)
'existflag = SheetsExist(sheetname)
'Worksheets(sheetname).Cells(1, 1).Activate
'Rows("1:1").Select
'Selection.Copy
'Windows("多个EXCEL文件合并.XLSM").Activate
'Worksheets("合并后数据").Cells(1, 1).Activate
'Rows("1:1").Select
'Selection.Insert Shift:=xlDown

'Windows(excelfilename).Activate
' ActiveWindow.Close

If falsenum = 0 Then
Else
MsgBox ("您一共打开了" & openfilenum & "个文件，其中" & falsenum & "个文件不包含您所输入的SHEETNMAE!请核查输入的文件名是否正确，以及所要合并的文件的格式是否一致")
End If
Application.StatusBar = "C程序执行已结束！！"
MsgBox ("程序运行时间为" & Format(Timer - tm & "秒 一共处理了" & filenum & "文件!"))

End Sub

Function dealfilename(ByVal str As Variant) '此函数完成的是动态的解出文件名，应该存在更简介的代码就可以实现这些功能
Dim arr As String
Dim j As Integer
j = 1
Dim strlen As Integer
strlen = Len(str)
Do While Not (Mid(str, strlen, 1) = "\")
strlen = strlen - 1
j = strlen
Loop
dealfilename = Right(str, Len(str) - j)
End Function
Function SheetsExist(wsName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(wsName)
On Error GoTo 0
SheetsExist = Not ws Is Nothing
Set ws = Nothing
End Function