qq_42678477的博客

Option ExplicitSub main() Dim xmlfiles, i xmlfiles = GetXmlFiles(ThisWorkbook.path & "\Data\*.xml") If IsEmpty(xmlfiles) Then Exit Sub For i = LBound(xmlfiles) To UBound(xmlfiles) FillBlock xmlfiles(i) Next End Su.

Option ExplicitSub test1() Dim sht Set sht = ActiveSheet Debug.Print GetDataXz(sht)End SubFunction GetDataXz(sht) Dim arr(1 To 8, 1 To 2), i, j, temp1, temp2, content '小组 For i = 1 To 8 arr(i, 1) = "'" & sht.Cells.

Option ExplicitType cwType xh As Integer xz As String cw As String sl As IntegerEnd TypeSub test() Debug.Print GetChaoShiTable(ActiveSheet)End SubFunction GetChaoShiTable(sht) Dim i, cwArr() As cwType, count, j, tableConte.

Option Compare DatabaseOption ExplicitSub Open_Ado_RS_Recordset() Dim rs As ADODB.Recordset, kfml, kfrq Set rs = New ADODB.Recordset rs.ActiveConnection = CurrentProject.Connection rs.CursorType = adOpenKeyset rs.LockType = adL.

Option ExplicitPrivate Sub Worksheet_Change(ByVal Target As Range) Excel.Application.EnableEvents = False Dim sht As Worksheet Set sht = Target.Parent If Target.Row = 1 And Target.Column = 10 Then If Target <> "" Then .

Option Explicit'输出Sub export() Dim sht As Worksheet, sql As String, sht1 As Worksheet, i, shtname, rng Set sht = ThisWorkbook.Worksheets("HZ") sql = "SELECT DISTINCT YF,SP,'' TB FROM CG order by yf,sp" exportdata sht, sql .

Sub Test() Dim sht As Worksheet, scr, content As String, i, arr_acsp_xz(1 To 8), arr_acsp_xz_data(1 To 8), arr_wemzs(1 To 13), arr_wemzs_data(1 To 13), temp Set sht = ThisWorkbook.Worksheets("小组") scr = "<script>" + vbCrLf scr =.

Option ExplicitSub exportdata() Dim sht As Worksheet, conn, rs, i Set sht = ActiveSheet Set conn = CreateObject("ADODB.Connection") Set rs = CreateObject("Adodb.Recordset") conn.Open "Provider=sqloledb;server=127.0.0.1,1433\sqlexpres.

class ImportorClass Option Explicit Private m_sht As Worksheet Private m_activecell As Range Private m_rowIndex As Long Private m_dictYjzh Private m_ksrq As Date Private m_jzrq As Date Private m_dictJsd Private m_r.

Option ExplicitSub test() Dim sht As Worksheet Set sht = ActiveSheet Debug.Print FindInterior(sht, 21, 65535)End SubFunction FindInterior(sht As Worksheet, line As Long, color As Long) Dim rng As Range, r, reg, col As Collection,.

1. vba冒泡排序Option ExplicitSub SelectionSort() Dim arr, i, j, temp arr = Array(1, 9, 10, 5, 4) PrintArr (arr) For i = LBound(arr) To UBound(arr) - 1 For j = LBound(arr) To UBound(arr) - 1 - i If arr(j) > arr(j + 1)

class UserForm1 Option Explicit Private Sub btnBillDir_Click() Me.txtBillDir.Text = GetFolder() End Sub Private Sub btnCiam_Click() Dim fileNameObj fileNameObj = Excel.Application.GetOpenFilename("Excel文件(.

Sub CreateSheets() Dim i For i = 1 To 30 Step 1 Sheets.Add(after:=Sheets(Sheets.Count)).Name = "4月" & i NextEnd SubSub DeleteSheets() Dim sht Excel.Application.DisplayAlerts = False For Each sht In Sheets If .

Option ExplicitSub test() Dim path, dict, item, sht, i, yjh, dir path = GetFolder() If path = "" Then Exit Sub Set dict = GetFilesDict(path) dir = GetDeskTopTimeDir() Set sht = ActiveSheet sht.Range("b2:b" & sh.

option explicitsub test() dim dict,arr,i set dict = CreateObject("Scripting.Dictionary") '一组数据放到字典 arr = Range("A1").CurrentRegion for i = 2 to UBound(arr) step 1 dict(arr(i,1)) = arr(i,2) next arr = Range("D1:E" &am.

Sub Button1_Click() Dim sht As Worksheet, rng As Range, picPath As String Set sht = ActiveSheet Set rng = ActiveCell If sht.Cells(1, rng.Column) <> "文件" Then Exit Sub picPa...

Function CreateGuid(ParamArray S() As Variant) As String CreateGuid = "{" + LCase(Mid$(CreateObject("Scriptlet.TypeLib").Guid, 2, 36)) + "}"End Function

Option ExplicitSub test() Dim i As Long For i = 2 To Sheet1.Range("A1000000").End(xlUp).Row Sheet1.Cells(i, 2) = GetStr(Sheet1.Cells(i, 1).Value, "^.*[a-zA-Z](?=\d)") ...

Option ExplicitSub main() Dim colNo As Integer, sht As Worksheet, lastRow As Long, i As Long, flag As Boolean colNo = InputBox("col no:") Excel.Application.DisplayAlerts = Fals...

测试代码Sub Add() Dim st As New SalaryTableCalss st.Create ActiveSheet st.AddTitleEnd SubSub Delete() Dim st As New SalaryTableCalss st.Create ActiveSheet st.DeleteOtherLin...

如，当前单元格的内容是 5,6,7，则仅显示5，6，7行，其余行隐藏Sub HIDE() Dim v As String, lines, i, firstLine, isFirstLine As Boolean v = ActiveCell.Value lines = Split(v, ",") ActiveSheet.Rows.Hidden =...