
正文
excel 宏循环行数据 ,Excel统计所有sheet数据行数 VBA
提示:扫一扫查出行【扫一扫了解最新限行尾号】
复制提示
Sub fun1()
'统计每一个sheet有多少行数据
Set s1 = Sheets("Sheet1")
'totalok = 0
For i = To Sheets.Count
s1.Cells(i, ) = Sheets(i).Name
r = Sheets(i).Range("A65535").End(xlUp).Rows1.Cells(i, ) = r
If i > Then
totalok = totalok + r
End If
Next
s1.Cells(, ) = totalok
End Sub
Sub Fun2()
'一个sheet表中循环查另一个sheet中是否存在,
‘查地名是否存在 OK 'Set Sheet = Worksheets("Sheet251")
Set dbSH = Sheets("pd_port")
'Set newSH = Sheets("(CN) CHINA") Cells(, ) = Now() ' 开始时间
Dim i
i =
Do While Cells(i, ) <> "" newCode = Trim(UCase(Cells(i, )))
newName = Trim(UCase(Cells(i, ))) isAirPort = ""
isSeaPort = ""
isRailway = ""
PortType = ' 0港口,1机场,2火车站 3其他 If InStr(newName, " APT") > Then
isAirPort = "Yes AirPort"
PortType =
End If
If InStr(newName, " PT") > Then
isSeaPort = "Yes SeaPort"
PortType =
End If
If InStr(newName, " RAILWAY") > Then
isRailway = "Yes Railway"
PortType =
End If r1 = "code No"
r2 = "name No"
For j = To
dbCode = Trim(UCase(dbSH.Cells(j, )))
dbName = Trim(UCase(dbSH.Cells(j, ))) If PortType = Then
dbName = Replace(dbName, " Apt", " AIRPORT") newCode = Right(newCode, )
newName = Replace(newName, " Apt", "")
End If If dbCode = newCode Then
r1 = "code Exist"
End If If dbName = newName Then
r2 = "name Exist"
End If
Next Cells(i, ) = r1
Cells(i, ) = r2 Cells(i, ) = isAirPort
Cells(i, ) = isSeaPort
Cells(i, ) = isRailway
Cells(i, ) = PortType
i = i +
Loop Cells(, ) = Now() ' 结束时间
End Sub
Sub Fun3()
'一个sheet表中循环查另一个sheet中是否存在,
’查地名是否存在 test 'Set Sheet = Worksheets("Sheet251")
Set dbSH = Sheets("pd_port")
'Set newSH = Sheets("(CN) CHINA") Cells(, ) = Now() ' 开始时间
Dim i
i =
'Do While Cells(i, 2) <> ""
For i = To
newCode = Trim(UCase(Cells(i, )))
newName = Trim(UCase(Cells(i, ))) isAirPort = ""
isSeaPort = ""
isRailway = ""
PortType = ' 0港口,1机场,2火车站 3其他 If InStr(newName, " APT") > Then
isAirPort = "Yes AirPort"
PortType =
End If
If InStr(newName, " PT") > Then
isSeaPort = "Yes SeaPort"
PortType =
End If
If InStr(newName, " RAILWAY") > Then
isRailway = "Yes Railway"
PortType =
End If r1 = "code No"
r2 = "name No"
For j = To
dbCode = Trim(UCase(dbSH.Cells(j, )))
dbName = Trim(UCase(dbSH.Cells(j, ))) If PortType = Then
dbName = Replace(dbName, " Apt", " AIRPORT") newCode = Right(newCode, )
newName = Replace(newName, " Apt", "")
End If If dbCode = newCode Then
r1 = "code Exist"
End If If dbName = newName Then
r2 = "name Exist"
End If
Next Cells(i, ) = r1
Cells(i, ) = r2 Cells(i, ) = isAirPort
Cells(i, ) = isSeaPort
Cells(i, ) = isRailway
Cells(i, ) = PortType
'i = i + 1
'Loop
Next
Cells(, ) = Now() ' 结束时间
End Sub
Sub Fun4()
' 查国家是否存在 ' Set Sheet = Worksheets("Sheet251")
Set dbSH = Sheets("pd_country")
Set newSH = Sheets("Country Name")
newSH.Cells(, ) = Now() ' 开始时间 For i = To
' Sheet.Rows(i).Cells (0)
' Print Sheet.Cells(i, 1)
' Print Worksheets("Sheet251").Cells(i, 1).Value
newCode = UCase(newSH.Cells(i, ))
newName = UCase(newSH.Cells(i, )) ResultCode = "code No"
ResultName = "name No"
For j = To
dbCode = UCase(dbSH.Cells(j, ))
dbName = UCase(dbSH.Cells(j, )) ' MsgBox dbValue + "---" + newValue
If dbCode = newCode Then
ResultCode = "code Exist"
End If If dbName = newName Then
ResultName = "name Exist"
End If Next newSH.Cells(i, ) = ResultCode
newSH.Cells(i, ) = ResultName newSH.Cells(, ) = Now() ' 结束时间
Next
End Sub
Sub stoCheckTable() msg = "一.请确保【申通账单】表格与【HELKA导出寄件数据】表格已准备;"
msg = msg + vbCrLf + "二.请确保第1个表格为【申通账单]表格】;"
msg = msg + vbCrLf + "三.请确保第2个表格为【HELKA导出寄件数据】表格;"
msg = msg + vbCrLf + "四.点[是]开始核对数据!"
msgResult = MsgBox(msg, vbYesNo, "申通快递数据核对") If msgResult = Then
Set stoTable = Sheets() '申通账单表格
Set helkaTable = Sheets() 'HELKA导出的表格 stoIndex = ' 申通的表格 第几行开始循环
NotFoundCount = '几条没有找到数量统计
Do While stoTable.Cells(stoIndex, ) <> ""
stoNo = Str(Trim(stoTable.Cells(stoIndex, )))
helkaIndex = 'HELKA导出的表格 第几行开始循环
okIndex =
Do While helkaTable.Cells(helkaIndex, ) <> ""
TempNo = Trim(helkaTable.Cells(helkaIndex, ))
If TempNo <> "" Then
helkaNo = Str(Trim(helkaTable.Cells(helkaIndex, ))) If (stoNo = helkaNo) Then
'MsgBox "找到了" + stoNo + "=" + helkaNo + "__ helkaIndex:" + Str(helkaIndex)
okIndex = helkaIndex
Exit Do
End If End If
helkaIndex = helkaIndex +
Loop
If okIndex > Then
stoTable.Cells(stoIndex, ) = "核对成功"
stoTable.Cells(stoIndex, ) = helkaTable.Cells(okIndex, )
stoTable.Cells(stoIndex, ) = helkaTable.Cells(okIndex, )
stoTable.Cells(stoIndex, ) = helkaTable.Cells(okIndex, ) Else
NotFoundCount = NotFoundCount +
stoTable.Cells(stoIndex, ) = "不存在"
stoTable.Cells(stoIndex, ).Interior.ColorIndex =
End If stoIndex = stoIndex +
Loop If NotFoundCount > Then
stoTable.Cells(stoIndex, ) = "核对结果"
stoTable.Cells(stoIndex, ) = "状态"
stoTable.Cells(stoIndex, ) = "物品名称"
stoTable.Cells(stoIndex, ) = "备注"
MsgBox "共发现" + Str(NotFoundCount) + " 条不存在的数据!"
Else
MsgBox "核对完成,所有单号都找到!"
End If End IfEnd Sub






