网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索

 
 
 
日一二三四五六
       
       
       
       
       
       

签到排名:今日本吧第个签到,

本吧因你更精彩,明天继续来努力!

本吧签到人数:0

一键签到
成为超级会员,使用一键签到
一键签到
本月漏签0次!
0
成为超级会员,赠送8张补签卡
如何使用?
点击日历上漏签日期,即可进行补签。
连续签到:天  累计签到:天
0
超级会员单次开通12个月以上,赠送连续签到卡3张
使用连续签到卡
11月25日漏签0天
excel吧 关注:281,826贴子:1,556,059
  • 看贴

  • 图片

  • 吧主推荐

  • 视频

  • 游戏

  • 首页 上一页 1 2 3 4
  • 51回复贴,共4页
  • ,跳到 页  
<<返回excel吧
>0< 加载中...

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

  • 取消只看楼主
  • 收藏

  • 回复
  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
好久没更新了,再放两段代码。
工作时间长了 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


  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
从同一个文件夹里边打开所有符合条件的文件,处理,然后关闭
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-25 06:43:32
广告
不感兴趣
开通SVIP免广告
  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
打开一个文件夹里边符合名称条件的所有文件,处理然后关闭。没什么特别的,展示下代码和思路。
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


  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
其实一个简单的办法 你在表格里插入一个ie窗口的对象 然后指向到这个页面 就会进行一些初始化的过程 vba就会工作了


  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
@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


  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
好久没来了,更新下近况。最近excel用的越来越少,主要使用excel来完成ETL的工作生成js格式数据。可视化部分使用js的highcharts来完成,过一段时间应该开始尝试使用qlikview软件。因为excel图形方面的短板,用的越来越少。


  • RuiWangChina
  • 小吧主
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
@Vitamin-M 抱歉 误删了帖子


登录百度账号

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频!
  • 贴吧页面意见反馈
  • 违规贴吧举报反馈通道
  • 贴吧违规信息处理公示
  • 首页 上一页 1 2 3 4
  • 51回复贴,共4页
  • ,跳到 页  
<<返回excel吧
分享到:
©2025 Baidu贴吧协议|隐私政策|吧主制度|意见反馈|网络谣言警示