VBA编程备忘录

2021/1/28 15:01
Jimmy

备忘录1:
'删除重复记录
Sub RemoveDuplicateRecord()
Dim Row0 As Long, Row1 As Long
With Worksheets("Sheet1") '工作表名称
Row0 = .Cells(1048576, 1).End(xlUp).Row
.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlYes
Row1 = .Cells(1048576, 1).End(xlUp).Row
End With
'MsgBox "共删除" & Row0 - Row1 & "(" & Row0 & "-" & Row1 & ")" & "条记录", vbInformation, "提示"
End Sub
'重新排序新生成数据
With ActiveWorkbook.Worksheets("2.自动选择容器装载").Sort
sum_rows = ActiveSheet.[T65536].End(xlUp).Row '获取T列行数
'MsgBox sum_rows
.SortFields.Clear
.SortFields.Add Key:=Range("U4"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal ' 降序排列: xlAscending 升序排列: xlDescending
.SetRange Worksheets("2.自动选择容器装载").Range("T4:U" & sum_rows)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

备忘录2:列号用变量代替
Worksheets("Sheet1").Range("A" & a).Value = countgood1

备忘录3:单元格取值
count_good1 = Worksheets("2.自动选择容器装载").Range("H5").Value

备忘录4:单无格赋值
Worksheets("Sheet1").Range("A" & a).Value = i '将i值输出到表名为：sheet1的"A" & a单元格中，其中a行号为变量

备忘录5:获取指定表中A列最大行数
rows = Sheet1.Range("A65536").End(xlUp).Row

备忘录6:获取单格指定日期型数据
count_month = Format([司机APP及时操作率!J2], "YYYY-MM") 注：[] 内的内容为sheet名+!+单元格位置

备忘录7:查询条件中，变量的用法：
'%" & count_month & "%' 注：单引号中双引号及双连接号，这里%%是mysql中模糊查询指定符号

备注录8:通过获取msgbox的变量值:
reply = MsgBox("将耗时" & ThisWorkbook.Worksheets("CLP Solver Console").Cells(14, 3).Value & " 秒,是否继续?", vbYesNo, "计算器")

备注录9:通过弹窗聚会并把变量传递给数据表名
Sub Verification_code()
Call celar_Verification_code
Dim mRng$
count_month = Format(Date, "YYYY-MM-DD")
mRng = InputBox("输入的月份格式为:YYYY-MM-DD", "请输入收车时间的月份", count_month)
table_name = Format(mRng, "YYYYMM")
' MsgBox "table_name: " & table_name & ""
If mRng <> "" Then
Dim strconnt As String
strconnt = ""
Set connt = New ADODB.Connection
Dim sevip, Db, user, pwd As String

sevip = "XXXX"
port = "3306"
Db = "DB"
user = "root"
pwd = "password"
Sql = " SELECT * FROM table_" & table_name & " where DATE_FORMAT(send_date,'%Y-%m-%d') like '%" & mRng & "%' "
strconnt = "DRIVER={MySql ODBC 5.3 Unicode Driver};SERVER=" & sevip & ";port=" & port & ";Database=" & Db & ";Uid=" & user & ";Pwd=" & pwd & ";Stmt=set names GBK"
connt.ConnectionString = strconnt
connt.Open
Set Rec = New Recordset
Set Rec = connt.Execute(Sql, iRowscount, adCmdText)
' 提取验证码为sheet名称
Range("提取验证码!A3").CopyFromRecordset Rec
Rec.Close: Set Rec = Nothing
connt.Close: Set connt = Nothing
'ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
Else
MsgBox "你输入数据非法!"
End If
End Sub

10.新电脑(Win10 x64,Office 2016 x32 )运行vba链接mysql时提示:

错误代码:80004005 ,信息: 未指定默认驱动程序

解决方法:
1.VBA连接MySql前的准备
Tools--->References..---->引用
勾选Microsoft ActiveX Data Objects 2.8 Librarys 和Microsoft ActiveX Data Objects Recordset 2.8 Librarys
2.若Office 是32位,安装32位驱动: mysql-connector-odbc-5.3.6-win32
若Office 是64位,则安装64位驱动: mysql-connector-odbc-5.3.8-winx64

11. vba-删除排除条件之外的工作表
' 删除排除条件之外的工作表
Sub clean_other_sheet()
Dim sht As Worksheet
Application.DisplayAlerts = False
For Each sht In Worksheets
If sht.Name <> "原始数据" And _
sht.Name <> "批量处理" And _
sht.Name <> "分页模板" Then
sht.Delete
End If
Next sht
End Sub

12.Sub clean_oldpage()
' 删除排除条件之外的工作表
Dim sht As Worksheet
Application.DisplayAlerts = False
For Each sht In Worksheets
If sht.Name <> "原始数据" And _
sht.Name <> "批量处理" And _
sht.Name <> "分页模板" Then
sht.Delete
End If
Next sht
End Sub

13. vba-循环删除空行（excel）
Dim LastRow As Long, r As Long
LastRow = Sheets(sheet页名称).UsedRange.Rows.Count
LastRow = LastRow + Sheets(sheet页名称).UsedRange.Row - 1
For r = LastRow To 1 Step -1
If Worksheets(CurOrder).Range("A" & r).Value = "" Then
Sheets(CurOrder).Rows(r).Delete
End If
Next r

14. '复制某个sheet页到excel新文件中
Sheets(CurOrder).Select
Sheets(CurOrder).Copy
ActiveWorkbook.SaveAs CurOrder & ".xls"
ActiveWorkbook.Close