初学vba,程序运行中总出现要求对象的错误提示
Subchangbiao()DimwbAsWorkbook,s%DimfilesetApplication.ScreenUpdating=Falsefileset=App...
Sub changbiao()
Dim wb As Workbook, s%
Dim fileset
Application.ScreenUpdating = False
fileset = Application.GetOpenFilename(filefilter:="microsoft excel files(*.xls),*.xls", MultiSelect:=True)
s = 3
For Each Filename In fileset
Workbooks.Open Filename
Dim sh1 As Worksheets
Dim YD$, LT$, DX$, GD$, TT$, QT$
Set wb = GetObject(ThisWorkbook.Path & "\" & "唱标记录及分析.xlsm")
Set sh1 = Filename.Sheets(1)
Set YD = wb.Sheets(1).Range("D1").MergeArea '移动
Set LT = wb.Sheets(1).Range("I1").MergeArea '联通
Set DX = wb.Sheets(1).Range("N1").MergeArea '电信
Set GD = wb.Sheets(1).Range("S1").MergeArea '广电
Set TT = wb.Sheets(1).Range("X1").MergeArea '铁塔
Set QT = wb.Sheets(1).Range("AC1").MergeArea '其他
On Error GoTo Havemistic
Function getproj(clu As Integer, b As Integer)
For j = 5 To 1 Step -1 '判断专业,加计数值
Dim a$
Set a = 4 + (clu - 1) * 5
If "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a)" Then
Set wb.Sheets(1).Cells(b, a) = sh1.Range("F8") '专业1
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+1)" Then
Set wb.Sheets(1).Cells(b, a + 1) = sh1.Range("F8") '专业2
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+2)" Then
Set wb.Sheets(1).Cells(b, a + 2) = sh1.Range("F8") '专业3
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+3)" Then
Set wb.Sheets(1).Cells(b, a + 3) = sh1.Range("F8") '专业4
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+4)" Then
Set wb.Sheets(1).Cells(b, a + 4) = sh1.Range("F8") '专业5
End If
Next j
End Function
' With wb.Sheets(1)
wb.Sheets(1).Cells(s, 1) = sh1.Range("B2")
wb.Sheets(1).Cells(s, 2) = Year(sh1.Cells(5, 7))
wb.Sheets(1).Cells(s, 3) = Month(sh1.Cells(5, 7))
'End With
For i = 6 To 1 Step -1
If "sh1.Cells(2,5)=YD.Cells(1,4).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否移动
ElseIf "sh1.Cells(2,5)=LT.Cells(1,9).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否联通
ElseIf "sh1.Cells(2,5)=LT.Cells(1,14).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否电信
ElseIf "sh1.Cells(2,5)=LT.Cells(1,19).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否广电
ElseIf "sh1.Cells(2,5)=LT.Cells(1,24).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否铁塔
ElseIf "sh1.Cells(2,5)=LT.Cells(1,29).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否其他
End If
Next i
s = s + 1
wb.Close False
Next
ExitSub:
Application.ScreenUpdating = True
End Sub 展开
Dim wb As Workbook, s%
Dim fileset
Application.ScreenUpdating = False
fileset = Application.GetOpenFilename(filefilter:="microsoft excel files(*.xls),*.xls", MultiSelect:=True)
s = 3
For Each Filename In fileset
Workbooks.Open Filename
Dim sh1 As Worksheets
Dim YD$, LT$, DX$, GD$, TT$, QT$
Set wb = GetObject(ThisWorkbook.Path & "\" & "唱标记录及分析.xlsm")
Set sh1 = Filename.Sheets(1)
Set YD = wb.Sheets(1).Range("D1").MergeArea '移动
Set LT = wb.Sheets(1).Range("I1").MergeArea '联通
Set DX = wb.Sheets(1).Range("N1").MergeArea '电信
Set GD = wb.Sheets(1).Range("S1").MergeArea '广电
Set TT = wb.Sheets(1).Range("X1").MergeArea '铁塔
Set QT = wb.Sheets(1).Range("AC1").MergeArea '其他
On Error GoTo Havemistic
Function getproj(clu As Integer, b As Integer)
For j = 5 To 1 Step -1 '判断专业,加计数值
Dim a$
Set a = 4 + (clu - 1) * 5
If "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a)" Then
Set wb.Sheets(1).Cells(b, a) = sh1.Range("F8") '专业1
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+1)" Then
Set wb.Sheets(1).Cells(b, a + 1) = sh1.Range("F8") '专业2
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+2)" Then
Set wb.Sheets(1).Cells(b, a + 2) = sh1.Range("F8") '专业3
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+3)" Then
Set wb.Sheets(1).Cells(b, a + 3) = sh1.Range("F8") '专业4
ElseIf "sh1.Cell(2,4)=wb.Sheets(1).Cells(2,a+4)" Then
Set wb.Sheets(1).Cells(b, a + 4) = sh1.Range("F8") '专业5
End If
Next j
End Function
' With wb.Sheets(1)
wb.Sheets(1).Cells(s, 1) = sh1.Range("B2")
wb.Sheets(1).Cells(s, 2) = Year(sh1.Cells(5, 7))
wb.Sheets(1).Cells(s, 3) = Month(sh1.Cells(5, 7))
'End With
For i = 6 To 1 Step -1
If "sh1.Cells(2,5)=YD.Cells(1,4).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否移动
ElseIf "sh1.Cells(2,5)=LT.Cells(1,9).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否联通
ElseIf "sh1.Cells(2,5)=LT.Cells(1,14).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否电信
ElseIf "sh1.Cells(2,5)=LT.Cells(1,19).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否广电
ElseIf "sh1.Cells(2,5)=LT.Cells(1,24).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否铁塔
ElseIf "sh1.Cells(2,5)=LT.Cells(1,29).Value" Then
Call getproj(i, s) '调用专业判断函数,判断运营商是否其他
End If
Next i
s = s + 1
wb.Close False
Next
ExitSub:
Application.ScreenUpdating = True
End Sub 展开
1个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询