VBA 上传数据与查找数据 while循环 和 for循环

Option Explicit
 上传数据
Private Sub CommandButton1_Click()
If MsgBox("请确认数据是否准确,是否确认上传?", vbCritical + 6 + 16, "温馨提示") = vbNo Then
  Exit Sub
End If
'保存数据
Dim r, Atnum, rscount, i As Integer
r = 6
Atnum = Sheet1.UsedRange.Rows.Count
 
If Atnum < 6 Then
  MsgBox "无数据可上传!"
  Exit Sub
End If
 
Call OpenCn
Dim sql As String
sql = "insert into demo_based(bemployee) values(1194)"
cn.Execute sql
 
Call CloseCn
If Err.Number <> 0 Then
  MsgBox Err.Description
Else
  MsgBox "数据上传成功,共上传了" + CStr(Atnum - 5) + "条数据"
End If
End Sub
 

核查数据,while循环
Private Sub CommandButton3_Click()
Dim sql, bl, tl As String, rsnum As Integer, DNum, i, sum, r As Integer
DNum = Sheet1.UsedRange.EntireRow.Count
 
Call OpenCn
 i = 6
 While (Len(Sheet1.Cells(i, 1)) > 0)
     MsgBox i
     bl = Sheet1.Range("A" & i)
      sql = "select id,bgroup,company,department_id from hr_employee where job_no='" + bl + "'"
      rs.CursorLocation = adUseClient
      rs.Open sql, cn, 1, 1
      With Sheet1
          .Range("T" & i).CopyFromRecordset rs  '添加数据到excel表中
            rsnum = .UsedRange.EntireRow.Count
           ' .Range("T" + CStr(rsnum)).Borders.LineStyle = 1   '给单元格加边框
      End With
      rs.Close
   i = i + 1
   sum = i - 6
 Wend
        MsgBox "完成" + CStr(sum) + "核查"
Call CloseCn
           
End Sub
 
这是for循环,核查数据
Private Sub CommandButton3_Click()
Dim sql, bl, tl As String, rsnum As Integer, DNum, i, r As Integer
DNum = Sheet1.UsedRange.EntireRow.Count
 
Call OpenCn
  For i = 6 To DNum
     bl = Sheet1.Range("A" & i)
      sql = "select id,bgroup,company,department_id from hr_employee where job_no='" + bl + "'"
      rs.CursorLocation = adUseClient
      rs.Open sql, cn, 1, 1
      With Sheet1
          .Range("T" & i).CopyFromRecordset rs  '添加数据到excel表中
            rsnum = .UsedRange.EntireRow.Count
           ' .Range("T" + CStr(rsnum)).Borders.LineStyle = 1   '给单元格加边框
      End With
      rs.Close
   Next
        MsgBox "完成" + CStr(DNum - 5) + "核查"
Call CloseCn
 
End Sub

心有猛虎,细嗅蔷薇
原文地址:https://www.cnblogs.com/1314520xh/p/7519114.html