weixin_34280060的博客

需求：数据表名这列相同的表，汇总数据要素，并以、隔开效果实现代码：Sub test()Application.ScreenUpdating = Falsen = 1Set d = CreateObject("scripting.dictionary")arr = [a1].CurrentRegionFor i = 1 To UBound(arr) d(arr(i, 1)) = d(arr(i, 1)) & arr(i, 2) & "、"Next[e1].Res

Sub 宏1() Application.ScreenUpdating = False '屏幕更新关闭 Application.DisplayAlerts = False '显示和预警提示关闭 Dim folder As String 'String字符串 folder = ThisWorkbook.Path & "\ 班级 " If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder 'vbDirectory文件夹

过录程序Sub test() Dim r, i, s, k As Integer, lj, str As String, arr Sheet1.Range("3:65536").Delete Application.ScreenUpdating = False Application.DisplayAlerts = False r = 2 str = ThisWorkbook.Path & "\堂食问卷\" '堂食问

Sub ali()Dim iApplication.ScreenUpdating = Falsei = 3For i = 1 To Application.Sheets(1).UsedRange.Rows.Count - 1If Len(Sheet1.Cells(i, 21)) > 0 ThenSheet1.Cells(i, 10).ClearCommentsSheet1.Cells(i, 10).AddComment.Text Text:=“一检：” & Cells(i, 21

Sub update()Application.DisplayAlerts = FalseActiveWorkbook.RefreshAllActiveWorkbook.SaveApplication.DisplayAlerts = TrueEnd Sub

Sub order() Dim strConn As String, strSQL As String Dim conn As ADODB.Connection Dim ds As ADODB.Recordset Dim Str As String Dim Str1 As String Dim Str2 As String Dim st As Integer Dim i As Integer, j As Integer

Sub inputdate()Dim strConn As String, strSQL As StringDim conn As ADODB.ConnectionDim ds As ADODB.RecordsetDim Str As StringDim Str1 As StringDim st As StringDim i As Integer, j As Integer Str = "'" & Worksheets("raw").Range("C1").Value & "

Sub order()Dim strConn As String, strSQL As StringDim conn As ADODB.ConnectionDim ds As ADODB.RecordsetDim Str As StringDim Str1 As StringDim st As StringDim i As Integer, j As Integer Str = "'" & Worksheets("交叉现金贷").Range("C1").Value & "'"

第一、将多张工作表中的数据合并到一张工作表中Sub hebing() '把各班成绩表中的记录合并到"成绩表"工作表中 Dim sht As Worksheet Set sht = Worksheets("成绩表") sht.Rows("2:65536").Clear '删除成绩表中的原有记录 Dim wt As Worksheet,...

Excel里面有客户的名字、身份证、性别、手机号，通过批量更新offer的这4个变量批量生成offer。VBA代码如下： Sub CreateWord() Dim mypath, Newname, i, XB, wApp mypath = ThisWorkbook.Path & “\” For i = 2 To [a1048576].End(xlUp).Row Newname...