Last active
December 16, 2015 02:19
-
-
Save aoshiman/5361721 to your computer and use it in GitHub Desktop.
twitterのアーカイブ(tweet.zip)に入っているtweets.csvをExcelに展開するvba
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Dim wkFile, wkPrompt As String | |
Dim wkFileName As Variant | |
Dim strFileName As String | |
Dim objStream As Object | |
Dim objRegExp As Object | |
Dim ii As Long | |
Dim jj As Long | |
Dim strReadBuffer As String | |
Dim arrReadData() As String | |
Sub tweetsCSV_Read() | |
Dim t | |
Dim wkReturn As Integer | |
wkReturn = MsgBox("Import tweets.csv" & vbCr & _ | |
"ok or cancel ?", vbOKCancel) | |
If wkReturn = vbOK Then | |
Else | |
Exit Sub | |
End If | |
wkFile = "CSV file (*.csv),*.csv" | |
wkPrompt = "select your tweets.csv" | |
wkFileName = fileToOpen(wkFile, wkPrompt) | |
If wkFileName = False Then | |
Exit Sub | |
Else | |
strFileName = wkFileName | |
End If | |
't = Timer | |
Worksheets(ActiveSheet.Name).Select | |
ActiveSheet.AutoFilterMode = False | |
Call dataClear | |
Set objStream = CreateObject("ADODB.Stream") | |
With objStream | |
.Open | |
.Type = adTypeText | |
.Charset = "UTF-8" | |
.LineSeparator = adLF | |
.LoadFromFile (strFileName) | |
End With | |
Set objRegExp = CreateObject("VBScript.RegExp") | |
objRegExp.Pattern = "<[^>]*>" | |
objRegExp.Global = True | |
ii = 1 | |
Application.ScreenUpdating = False | |
Do While Not objStream.EOS | |
strReadBuffer = objStream.ReadText(adReadLine) | |
arrReadData = Split(strReadBuffer, ",") | |
For jj = LBound(arrReadData) To UBound(arrReadData) | |
If ii = 1 Then | |
arrReadData(jj) = Replace(arrReadData(jj), """", "") | |
Else | |
If jj = 5 Then | |
arrReadData(jj) = Replace(arrReadData(jj), "-", "/") | |
arrReadData(jj) = Left(arrReadData(jj), 8) | |
End If | |
If jj = 6 Then | |
arrReadData(jj) = objRegExp.Replace(arrReadData(jj), "") | |
End If | |
arrReadData(jj) = Replace(arrReadData(jj), """", "") | |
End If | |
Cells(ii, jj + 1) = arrReadData(jj) | |
Next jj | |
ii = ii + 1 | |
Loop | |
objStream.Close | |
Set objRegExp = Nothing | |
Application.ScreenUpdating = True | |
Worksheets(ActiveSheet.Name).Select | |
'MsgBox Timer -t | |
MsgBox ("Done.") | |
End Sub | |
Function fileToOpen(pFile, pPrompt) As Variant | |
fileToOpen = Application.GetOpenFilename(pFile, , pPrompt) | |
End Function | |
Function dataClear() | |
Worksheets(ActiveSheet.Name).Select | |
Range("A1:J65536").ClearContents | |
Range("A1").Select | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
twitterのアーカイブ(tweet.zip)に入っているtweets.csvをExcelに展開するVBA
(英語版でtweet.zipを申請しないとcsvが入っていないとのこと)
動かすには VBE参照設定にて
a)Microsoft VBScript Regular Expressions(VBScript_RegExp)
b)Microsoft ActiveX Data Objects Library(ADODB)
がチェックされている必要があります。
実際に展開してみると分かるのですが、
1)tweet内容に改行が入っている
2)tweet内容にカンマが含まれている
3)expanded_urlsという項目のデータ発生が不定期(データが発生しない場合、カンマも発生しない)
により値が正しくセルに反映していない箇所が出ます。
フィルタ操作により該当箇所を修正するなどして下さい
当方、現時点でのtweets.csvの行数は12870です。Excel2003で動作確認しています。
それ以上の行数(件数)では試していません。ちなみに自分の環境では60秒程かかります(汗
もっとうまい書き方、速くなる書き方ございましたら教えてください。