excel 宏循环行数据 ,Excel统计所有sheet数据行数 VBA

Sub fun1()
'统计每一个sheet有多少行数据
Set s1 = Sheets("Sheet1")
'totalok = 0
For i = 1 To Sheets.Count
s1.Cells(i, 1) = Sheets(i).Name
r = Sheets(i).Range("A65535").End(xlUp).Row

s1.Cells(i, 2) = r
If i > 4 Then
totalok = totalok + r
End If
Next
s1.Cells(1, 3) = totalok
End Sub

 
Sub Fun2()
    '一个sheet表中循环查另一个sheet中是否存在,
查地名是否存在 OK 'Set Sheet = Worksheets("Sheet251") Set dbSH = Sheets("pd_port") 'Set newSH = Sheets("(CN) CHINA") Cells(1, 12) = Now() ' 开始时间 Dim i i = 2 Do While Cells(i, 2) <> "" newCode = Trim(UCase(Cells(i, 2))) newName = Trim(UCase(Cells(i, 4))) isAirPort = "" isSeaPort = "" isRailway = "" PortType = 3 ' 0港口,1机场,2火车站 3其他 If InStr(newName, " APT") > 0 Then isAirPort = "Yes AirPort" PortType = 1 End If If InStr(newName, " PT") > 0 Then isSeaPort = "Yes SeaPort" PortType = 0 End If If InStr(newName, " RAILWAY") > 0 Then isRailway = "Yes Railway" PortType = 2 End If r1 = "code No" r2 = "name No" For j = 2 To 5192 dbCode = Trim(UCase(dbSH.Cells(j, 6))) dbName = Trim(UCase(dbSH.Cells(j, 4))) If PortType = 1 Then dbName = Replace(dbName, " Apt", " AIRPORT") newCode = Right(newCode, 3) 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, 12) = r1 Cells(i, 13) = r2 Cells(i, 14) = isAirPort Cells(i, 15) = isSeaPort Cells(i, 16) = isRailway Cells(i, 17) = PortType i = i + 1 Loop Cells(1, 13) = Now() ' 结束时间 End Sub
Sub Fun3()
    
'一个sheet表中循环查另一个sheet中是否存在,
  ’
查地名是否存在 test 'Set Sheet = Worksheets("Sheet251") Set dbSH = Sheets("pd_port") 'Set newSH = Sheets("(CN) CHINA") Cells(1, 12) = Now() ' 开始时间 Dim i i = 2 'Do While Cells(i, 2) <> "" For i = 1105 To 1110 newCode = Trim(UCase(Cells(i, 2))) newName = Trim(UCase(Cells(i, 4))) isAirPort = "" isSeaPort = "" isRailway = "" PortType = 3 ' 0港口,1机场,2火车站 3其他 If InStr(newName, " APT") > 0 Then isAirPort = "Yes AirPort" PortType = 1 End If If InStr(newName, " PT") > 0 Then isSeaPort = "Yes SeaPort" PortType = 0 End If If InStr(newName, " RAILWAY") > 0 Then isRailway = "Yes Railway" PortType = 2 End If r1 = "code No" r2 = "name No" For j = 2 To 5192 dbCode = Trim(UCase(dbSH.Cells(j, 6))) dbName = Trim(UCase(dbSH.Cells(j, 4))) If PortType = 1 Then dbName = Replace(dbName, " Apt", " AIRPORT") newCode = Right(newCode, 3) 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, 12) = r1 Cells(i, 13) = r2 Cells(i, 14) = isAirPort Cells(i, 15) = isSeaPort Cells(i, 16) = isRailway Cells(i, 17) = PortType 'i = i + 1 'Loop Next Cells(1, 13) = Now() ' 结束时间 End Sub
Sub Fun4()
    ' 查国家是否存在

     ' Set Sheet = Worksheets("Sheet251")
     Set dbSH = Sheets("pd_country")
     Set newSH = Sheets("Country Name")
    newSH.Cells(1, 3) = Now() ' 开始时间
    
    For i = 2 To 250
       ' Sheet.Rows(i).Cells (0)
       ' Print Sheet.Cells(i, 1)
      ' Print Worksheets("Sheet251").Cells(i, 1).Value
      newCode = UCase(newSH.Cells(i, 1))
      newName = UCase(newSH.Cells(i, 2))
      
      ResultCode = "code No"
      ResultName = "name No"
      For j = 1 To 255
        dbCode = UCase(dbSH.Cells(j, 5))
        dbName = UCase(dbSH.Cells(j, 3))
        
        ' 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, 3) = ResultCode
      newSH.Cells(i, 4) = ResultName
      

      
      newSH.Cells(1, 4) = 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 = 6 Then
        Set stoTable = Sheets(1) '申通账单表格
        Set helkaTable = Sheets(2) 'HELKA导出的表格
        
        stoIndex = 3 ' 申通的表格 第几行开始循环
        NotFoundCount = 0 '几条没有找到数量统计
        Do While stoTable.Cells(stoIndex, 2) <> ""
            stoNo = Str(Trim(stoTable.Cells(stoIndex, 2)))
                helkaIndex = 2 'HELKA导出的表格 第几行开始循环
                okIndex = 0
                Do While helkaTable.Cells(helkaIndex, 1) <> ""
                    TempNo = Trim(helkaTable.Cells(helkaIndex, 3))
                    If TempNo <> "" Then
                        helkaNo = Str(Trim(helkaTable.Cells(helkaIndex, 3)))
                        
                        If (stoNo = helkaNo) Then
                            'MsgBox "找到了" + stoNo + "=" + helkaNo + "__ helkaIndex:" + Str(helkaIndex)
                            okIndex = helkaIndex
                            Exit Do
                        End If
                        
                    End If
                    helkaIndex = helkaIndex + 1
                Loop
                If okIndex > 0 Then
                    stoTable.Cells(stoIndex, 12) = "核对成功"
                    stoTable.Cells(stoIndex, 13) = helkaTable.Cells(okIndex, 4)
                    stoTable.Cells(stoIndex, 14) = helkaTable.Cells(okIndex, 5)
                    stoTable.Cells(stoIndex, 15) = helkaTable.Cells(okIndex, 6)
                    
                Else
                    NotFoundCount = NotFoundCount + 1
                    stoTable.Cells(stoIndex, 12) = "不存在"
                    stoTable.Cells(stoIndex, 12).Interior.ColorIndex = 6
                End If
                
            stoIndex = stoIndex + 1
        Loop
        
        
        If NotFoundCount > 0 Then
            stoTable.Cells(stoIndex, 12) = "核对结果"
            stoTable.Cells(stoIndex, 13) = "状态"
            stoTable.Cells(stoIndex, 14) = "物品名称"
            stoTable.Cells(stoIndex, 15) = "备注"
            MsgBox "共发现" + Str(NotFoundCount) + " 条不存在的数据!"
        Else
            MsgBox "核对完成,所有单号都找到!"
        End If
        
    End If
    
End Sub

 

posted @ 2019-08-01 10:34  为乐而来  阅读(3734)  评论(0编辑  收藏  举报