摘要：
Public res_cnt Public ar_res(1 To 100, 1 To 20) Public k Sub main() Call varInit Call ReadFile Call outputLastManyRow '输出遗漏的尾巴行数 End Sub Private Sub R 阅读全文
posted @ 2022-11-17 20:40
依云科技
阅读(192)
评论(0)
推荐(0)
摘要：
Public Function sort(arr As Variant) Dim MaxV As Variant a = UBound(arr) b = a For i = a To 0 Step -1 MaxV = arr(i) For j = 0 To b If arr(j) > MaxV Th 阅读全文
posted @ 2022-11-17 20:39
依云科技
阅读(24)
评论(0)
推荐(0)
摘要：
Function getRandArr() getRandArr = GetRnd(0, 26, 26 + 1)End Function'GetSpecifiedIntervalRndData'获取指定区间不重复的随机数Function GetRnd(a&, b&, n&)'a 区间起始数 b 区间 阅读全文
posted @ 2022-11-17 20:38
依云科技
阅读(46)
评论(0)
推荐(0)
摘要：
'FileSaveAsWorkBook'将文件另存为工作簿 Sub QuotationSaveAs()Dim strNumApplication.DisplayAlerts = FalseClosetbAndlbSet wb = ActiveWorkbook 'Range(Cells(1, 1), 阅读全文
posted @ 2022-11-17 20:38
依云科技
阅读(45)
评论(0)
推荐(0)
摘要：
Sub ExcelDataWriteInWord(sourceArr, MaxCol, wordModelName)'根据给定的word模板将Excel表格数据批量写入word'参数说明'sourceArr 要写入word的数据源数组'MaxCol 最大列号'wordModelName word模板 阅读全文
posted @ 2022-11-17 20:38
依云科技
阅读(691)
评论(0)
推荐(0)
摘要：
'DictionaryMethodMulOverload'常见字典应用方法及重载'subtotal 分类汇总Function subTotal(arr As Variant) Dim d As Object Set d = CreateObject("scripting.dictionary") F 阅读全文
posted @ 2022-11-17 20:37
依云科技
阅读(78)
评论(0)
推荐(0)
摘要：
Sub main() '归并排序a = c_randomize_not_repeated.getRandDigitsort aDebug.Print 1End Sub Sub sort(a)Dim aux()ReDim aux(UBound(a))doSort a, aux, 0, UBound(a 阅读全文
posted @ 2022-11-17 20:36
依云科技
阅读(824)
评论(0)
推荐(0)
摘要：
Function getRandDigit() ' arr = GetRnd(1, 13137, 13137) getRandDigit = arr' Sheets("Sheet1").Range("M2").Resize(UBound(arr)) = Application.Transpose(a 阅读全文
posted @ 2022-11-17 20:35
依云科技
阅读(31)
评论(0)
推荐(0)
摘要：
'Option Explicit Private Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, _ ByVal szURL As Strin 阅读全文
posted @ 2022-11-17 20:32
依云科技
阅读(63)
评论(0)
推荐(0)
摘要：
Sub Main()Set d = CreateObject("scripting.dictionary")arr = ActiveSheet.Range("a1").CurrentRegionFor x = 2 To UBound(arr)d(arr(x, 2)) = arr(x, 3)Nexta 阅读全文
posted @ 2022-11-17 20:30
依云科技
阅读(30)
评论(0)
推荐(0)
摘要：
Public row_abPublic row_cdPublic ar_titlePublic r_new_shtPublic sname'Public k'Public k1 Private Sub deleteSheet()Application.DisplayAlerts = FalseFor 阅读全文
posted @ 2022-11-17 20:29
依云科技
阅读(135)
评论(0)
推荐(0)
摘要：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Call UFItemsSelect.ClearListboxValueIf Target.Column = 14 ThenIf Targ 阅读全文
posted @ 2022-11-17 20:27
依云科技
阅读(56)
评论(0)
推荐(0)
摘要：
Private Sub CommandButton1_Click()With Sheets("科目表")If .Range("b2:b" & .[b65536].End(3).Row).Find(treeWorking.SelectedItem.Text) Is Nothing ThenActive 阅读全文
posted @ 2022-11-17 20:23
依云科技
阅读(46)
评论(0)
推荐(0)
摘要：
Public d, dIsExistsSub Main()Dim arr(1 To 80000)With Me.Cells.Interior.ColorIndex = 0r = .Cells(.Rows.Count, 1).End(xlUp).RowFor x = 1 To rFor y = x + 阅读全文
posted @ 2022-11-17 20:18
依云科技
阅读(20)
评论(0)
推荐(0)
摘要：
Private Sub CommandButton1_Click()Dim Myn1, Myn2On Error Resume NextApplication.ScreenUpdating = False '关闭屏幕刷新'If Dir("E:\课表数据", vbDirectory) = "" The 阅读全文
posted @ 2022-11-17 20:16
依云科技
阅读(311)
评论(0)
推荐(0)
摘要：
Public ar_Source As VariantSub Main()With Sheets("Source")lastrow = .Cells(.Rows.Count, 1).End(xlUp).Rowar_Source = .Range("b4:f" & lastrow)Call setco 阅读全文
posted @ 2022-11-17 20:13
依云科技
阅读(101)
评论(0)
推荐(0)
摘要：
Sub Main()Dim arExtendAfter()With Me ar = .Range("a1").CurrentRegionReDim arExtendAfter(1 To UBound(ar), 1 To 20)For x = 2 To UBound(ar)If Len(ar(x, 1 阅读全文
posted @ 2022-11-17 20:10
依云科技
阅读(94)
评论(0)
推荐(0)
摘要：
Sub main()Dim ar_source As VariantDim ar_excel_4_个人客户支付委托书(1 To 8) As VariantWith Sheets("Sheet1") ar_source = .Range("a1").CurrentRegion ar_excel_4_个 阅读全文
posted @ 2022-11-17 20:05
依云科技
阅读(503)
评论(0)
推荐(0)
浙公网安备 33010602011771号