qq_44390640的博客

提取最短距离SELECT D.LO1,D.LA1,D.LO2,D.LA2,D.DIS FROM ( SELECT A.LO AS LO1,A.LA AS LA1,B.LO AS LO2,B.LA AS LA2,111.12*atn(sqr(1-(SIN(a.LA*3.1415/180)*SIN(b.LA*3.1415/180)+COS(a.LA*3.1415/180)*COS(b.LA*3.1415/180)*COS((b.LO-a.LO)*3.1415/180))*(SIN(a.LA*3.1415/

SUB DATA()Dim cnn, SQL$, a, B, C, D, E, f, G, H, i, L, MDim OUT As Workbook Set cnn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") cnn.Open "Provider = Microsoft.ace.Oledb.12.0;Extended Properties =TEXT;Dat

Sub 行转列()Dim dic As Object, i As Long, arr, K, TSet dic = CreateObject("Scripting.Dictionary")arr = Worksheets("源数据").[A1].CurrentRegionWorksheets("结果").Cells.ClearReDim BRR(1 To UBound(arr), 1 To 3) '声明从2到N行，1到2列，如要添加输出字段请修改1 TO 5 For i = 2 To UBou

Sub 提取文件名()Dim strPNAME As StringDim nFNO As IntegerShell "cmd.exe /c DEL " & ThisWorkbook.Path & "\*.log"'Shell "cmd.exe /c DEL " & ThisWorkbook.Path & "\input\*.bat"'Shell "cmd.exe /c DEL " & ThisWorkbook.Path & "\input\*.

SCHTASKS /parameter [arguments]描述: 允许管理员创建、删除、查询、更改、运行和中止本地或远程系统上的计划任 务。替代 AT.exe。参数列表: /Create 创建新计划任务。 /Delete 删除计划任务。 /Query 显示所有计划任务。 /Change 更改计划任务属性。 /Run 立即运行计划任务。 /End

方法一：利用VBA创建ACCESS数据库Sub CR_DB() Dim AC As Object Set AC = CreateObject("ACCESS.APPLICATION") Db = ThisWorkbook.Path & "\test.accdb" If Dir(Db) <> "" Then Kill Db End If With AC .NEWCURRE

SUB 转置()Transfrom 统计项 select 行字段 from (数据源) group by 列字段 pivot 行字段Set cnn = CreateObject("ADODB.CONNECTION")Set RS = CreateObject("ADODB.RECORDSET")cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Ex...

Sub OptionalFeatureLicense() Dim Fs As Object, Ft As Object, S As String Set Fs = CreateObject("Scripting.FileSystemObject") Set d = CreateObject("scripting.dictionary") filePath = Th...

Sub 提取部分CSV数据()Dim FileName As StringDim txtLine As StringFileName = ThisWorkbook.Path & "\EUtranCellRelation.csv"Open FileName For Input As #1Open ThisWorkbook.Path & "\output.CSV" For ...

Sub copyfile() Dim fso As Object, sf$, df$ Dim fileNameObj As Variant Dim i As Integer fileNameObj = Application.GetOpenFilename("CSV 文件 (*.CSV),*.CSV") If fileNameObj <> Fa...

Sub 替换()Dim tmp As StringDim file As Stringfile = Dir(ThisWorkbook.Path + "\*.sql")Do While file <> "" Open ThisWorkbook.Path + "\" + file For Binary As #1 str= String(LOF(1), vbNull...

SUB 将查询结果保存为CSV ()If CheckBox1.Value = True ThenTEX = "A.EUTRANCELLFDD"ElseIf CheckBox2.Value = True ThenTEX = "A.EUTRANCELLTDD"End IfDim cnn, SQL$, A, B, C, D, E, f, G, H, i, L, M Set cnn...

Sub 故障汇总() Dim Fs As Object, Ft As Object Set Fs = CreateObject("Scripting.FileSystemObject") filePath = ThisWorkbook.Path & "\" fileName = Dir(filePath & "*.log", vbNormal) ...

Function 提取中文(str As String) As String Set regEx = CreateObject("vbscript.regexp") With regEx .Global = 1 .Pattern = "[Function RemoveNarrow(str As String) As String" Set r...

指定单元格I行5列生成的折线图，折线图值的范围是：H列I行：DC列I行的值Worksheets("SHEET1").Cells(I, 5).SparklineGroups.Add Type:=xlSparkLine, SourceData:="H" & I & ":DC" & I...

Sub 分厂家统计()Set cnn = CreateObject("adodb.Connection")Set rs = CreateObject("adodb.Recordset")cnn.Open "Provider = Microsoft.ace.Oledb.12.0;Extended Properties =TEXT;Data Source =" & ThisWork...

Sub 批量导入TXT或LOG并完成汇总() Dim Fs As Object, Ft As Object Set Fs = CreateObject("Scripting.FileSystemObject") filePath = ThisWorkbook.Path & "\" fileName = Dir(filePath & "*.log", ...

以下是根据和讯网实时提取资金流入股票的TOP情况Sub 实时提取股票资金流入TOP() Dim tmp(), TEMP1(), S, STR, STR_1, STR_2 As String, arr() As String, xmlhttp As Object, I, J, N As Long Worksheets("实时资金流入统计").Cells.Clear S...

Sub 生成图表()Worksheets("图表").ChartObjects.DeleteWith Worksheets("历史记录表")Set MYCHART = .ChartObjects.Add(10, 10, 500, 150) '左,上,长,高With MYCHART.Chart .ChartType = xlLineMarkers .SetSourceData So...

Sub 实时刷新()Call 时间End SubSub 时间()Dim newtimenewtime = Now + TimeValue("00:10:00")模块1.testApplication.OnTime newtime, "时间"End Sub

Sub 股票历史记录查询()Worksheets("历史记录表").Cells.Clear ''输出结果表X = Application.CountA(Worksheets("代码").Range("A:A")) ''需要提取的股票代码Y = 1For i = 2 To X dm = IIf(Worksheets("代码").Cells(i, 1) < 600000,...

Sub 正则()Set REG = CreateObject("VBSCRIPT.REGEXP")Dim STR As String, SX = WorksheetFunction.CountA(Worksheets("sheet1").Range("A:A")) For I = 1 To X STR = Cells(I, 1).Text With R...

SUB 合并所有SHEET() Dim MyPath, MyNameDim Wb As Workbook, WbN As StringDim I As LongDim Num As LongMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.xlsx")localName = ActiveWorkbo...

Sub 调用ACCESS数据库查询() Dim rst As New ADODB.Recordset Dim myPath As String Dim SQL As String Dim i As Integer myPath = ThisWorkbook.Path & "\新建 Microsoft Access 数据库 (4G-2G).ac...

Private Sub OptionButton36_Click()Dim i As IntegerDim s As String '存储生成的代码Dim f As String '保存的文件名Dim rng As Rangef = ThisWorkbook.Path & “\GZ.kml” '宏所在的文件内KML文件s = “<kml xmlns=”“http://...

Sub 总输出() ‘’不打开CSV文件进行读取汇总Set CNN = CreateObject("ADODB.CONNECTION")Set RS = CreateObject("ADODB.RECORDSET")CNN.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=...

Sub 查询数据库()Set rs = CreateObject("ADODB.RECORDSET") cnn.Open = "DSN=GSM;uid=ailxl;pwd=ailxl;Database=感知数据库;" 'TABLE=DBO.DATA;" Sql = "SELECT * FROM [Data] DATA WHERE YEAR([Datetime Id(GSM_CE...

Private Sub OptionButton37_Click() 'DT制作Shell "cmd.exe /c DEL " & ThisWorkbook.Path & "\*.mos"Application.Wait Now + TimeValue("00:00:01")Worksheets("脚本模板").ActivateX = WorksheetFunction...

Private Sub OptionButton39_Click() '提取功能Set rs = CreateObject("adodb.Recordset")cnn.Open "Provider = Microsoft.ace.Oledb.12.0;Extended Properties =TEXT;Data Source =" & ThisWorkbook.Path & "...

SUB 代替VLOOKUP() Dim d, ar, br, cr, wb As Workbook Set d = CreateObject("Scripting.Dictionary") br = Worksheets("Sheet1").[A1].CurrentRegion '需要配置的数据表 ar = Worksheets("R").[A1].CurrentRe...

Sub 字典汇总求和()Dim arr, d As Object, brr()Set d = CreateObject("scripting.dictionary")arr = [a1].CurrentRegionReDim brr(1 To UBound(arr), 1 To 3)For i = 1 To UBound(arr) If Not d.exists(arr(i, 1...

Sub 自定义获取股票信息() Worksheets("输出结果").Cells.Clear Worksheets("输出结果").Range("a1:AE1") = Array("代码", "股票名", "现价", "昨收", "今开", "成交量(手)", "外盘", "内盘", "买一", "买一量(手)", "卖一", "卖一量", "时间", "涨跌", "涨跌幅",...

Sub 行转列() Dim arr, BRR Worksheets("结果").Cells.Clear arr = Worksheets("TEST").[a1].CurrentRegion N = 2 For i = 2 To UBound(arr) BRR = Split(arr(i, 3), ",") '''''分列，...

BA+ADO不打开文件对TXT、CSV、EXCEL、ACCESS数据库、远程数据库进行数据提取、统计、汇总方法：Set cnn = CreateObject("ADODB.CONNECTION")Set rs = CreateObject("ADODB.RECORDSET"){**1）连接远程数据库方法：***cnn.Open = "DSN=GSM;uid=ailxl;pwd=ailx...

SUB 提取指定内定到TXT()Set CNN = CreateObject("ADODB.CONNECTION")Set RS = CreateObject("ADODB.RECORDSET")CNN.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\统计.accd...

SUB 格式()Worksheets("申报表" & i).Range("A1:I6").Interior.ColorIndex = 2 Worksheets("申报表" & i).Range("A" & O + 4 & " :J" & O + 4).Borders.LineStyle = xlContinuous Worksheets("申报表" ...

SUB 批量增加命名工作表() For L = 1 To 100Sheets.Add(, Sheets("发票表头")).Name = "发票表" & iNEXTEND SUBSUB 批量删除工作表()Application.DisplayAlerts = 0 ‘’‘关闭提示On Error Resume NextX = Worksheets.CountFor i ...

COPY表1包有格式内容到表2中Worksheets("申报表头").Range("A1:J4").Copy Destination:=Worksheets(“结果").Range("a1:j4")

Sub 分类()Dim ADim cnn, SQL$ Set cnn = CreateObject("adodb.connection") Set RS = CreateObject("adodb.recordset") cnn.Open "Provider = Microsoft.ace.Oledb.12.0;Extended Properties =TEXT;Data ...

Sub 合并多个csv文件为一个文件() Dim cnn As Object, SQL$, MyPath$, MyFile$, m& Set cnn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") MyPath = ThisWorkbook.Path &a...