网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索
excel吧 关注：281,825贴子：1,555,570

回复：Excel可以做什么，Excel工作笔记[全员乱入]

好久没更新了，再放两段代码。
工作时间长了 vba 越用越少
这段代码将选中的表格按行列拆开变成原始的数据，可以看成数据透视表的逆向操作。
选中区域运行就好。速度应该也快。输出是在选中区域的右边
代码比较精简，希望可以给大家提供些思路。
Sub UnPivot()
Dim i As Integer
Selection.Resize(1, 3).Offset(0, Selection.Columns.Count + 1) = Array("RowHeader", "ColumnHeader", "Value")
For i = 2 To Selection.Columns.Count
With Selection.Resize(Selection.Rows.Count - 1, 1).Offset(1 + (i - 2) * (Selection.Rows.Count - 1), Selection.Columns.Count)
.Offset(0, 1) = Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, 1).Value
.Offset(0, 2) = Selection.Cells(1, i).Value
.Offset(0, 3) = Selection.Offset(1, i - 1).Resize(Selection.Rows.Count - 1, i).Value
End With
Next
End Sub


从同一个文件夹里边打开所有符合条件的文件，处理，然后关闭
Sub LoopFiles()
Dim sFolder As String
Application.ScreenUpdating = False
sFolder = "Y:\_OutCADIS\Bulk Uploader History\2014 11 20 CDS Sector History FIx\HistoryData\"
Dim sFile As String
sFile = Dir(sFolder & "*.csv")
Do While Len(sFile) > 0
Application.StatusBar = sFile
Workbooks.Open sFolder & sFile, UpdateLinks:=False, ReadOnly:=True, local:=True
'-------------------------------------------
Rows("3:" & Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row).Copy
Workbooks("Book8").Activate
Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'-------------------------------------------
Workbooks(sFile).Close False
sFile = Dir()
Loop
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub


2025-11-24 21:22:45
广告
不感兴趣
开通SVIP免广告
打开一个文件夹里边符合名称条件的所有文件，处理然后关闭。没什么特别的，展示下代码和思路。
Sub LoopFiles()
Dim sFolder As String
Application.ScreenUpdating = False
sFolder = "C:\"
Dim sFile As String
sFile = Dir(sFolder & "*.csv")
Do While Len(sFile) > 0
Application.StatusBar = sFile
Workbooks.Open sFolder & sFile, UpdateLinks:=False, ReadOnly:=True, local:=True
'------------------------------------------- 打开后想干什么放这里
Rows("3:" & Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row).Copy
Workbooks("Book8").Activate
Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'-------------------------------------------
Workbooks(sFile).Close False
sFile = Dir()
Loop
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub


其实一个简单的办法 你在表格里插入一个ie窗口的对象 然后指向到这个页面 就会进行一些初始化的过程 vba就会工作了


@fengtf12 试试这种方法，现在第一个页面建立一个activex对象microsoft web browser，然后用na打开http://xueqiu.com/S/SH600175，这样内建的浏览器应该有cookie了，然后运行getwebfile，下载json的文件，试了试，直接修改股票代码SH600175到SH600176也好用。剩下的就是文本的处理了
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Sub Nav()
ActiveWorkbook.Sheets(1).WebBrowser1.Navigate "http://xueqiu.com/S/SH600175"
End Sub
Sub GetWebFile()
If URLDownloadToFile(0, "http://xueqiu.com/statuses/search.json?count=15&comment=0&symbol=SH600175&hl=0&source=all&sort=time&page=1&_=1422350957287", "H:\SH600175.txt", 0, 0) = 0 Then
Else
End If
End Sub


好久没来了，更新下近况。最近excel用的越来越少，主要使用excel来完成ETL的工作生成js格式数据。可视化部分使用js的highcharts来完成，过一段时间应该开始尝试使用qlikview软件。因为excel图形方面的短板，用的越来越少。


@Vitamin-M 抱歉 误删了帖子


扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！
分享到: