Option Explicit
'MsgBox関数の戻り値を格納する変数
Dim Msg
'MsgBoxのダイアログ・タイトルを示す定数
Const TITLE = "ダイアログ・クイズ"
'MsgBox関数の戻り値がMsgという変数に代入される
Msg = MsgBox("「アルプスの少女○○ジ」○○のところになにがくる?", vbQuestion + vbYesNoCancel, TITLE)
If Msg = vbYes Then 'もしMsgがvbYesなら
MsgBox "正解!たいしたもんだ。" , vbInformation, TITLE
ElseIf Msg = vbNo Then 'もしMsgがvbNoなら
MsgBox "ブー!「アルプスの少女イイエジ」ってことはないだろ。" , vbCritical, TITLE
Else 'それ以外の場合なら
MsgBox "キャンセルを押しました。" ,vbExclamation, TITLE
End If
------------------------------------------------------
■A1~1000に"1"を立てるというのでも、こうすると早い
ループ内で配列処理をし、吐き出すのを外で1回にすると更に早くなる。
Application.ScreenUpdating = False '画面表示停止
Application.Calculation = xlCalculationManual '自動計算停止
For i = 1 To 1000
For j = 1 To 100
Cells(i, j).Select
ActiveCell.FormulaR1C1 = 1
Next j
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
------------------------------------------------------
■CSVデータ読み込み
大体40秒。
Workbooks.Open Filename:= "C:\data.csv"
参照。
https://excel-ubara.com/excelvba5/EXCELVBA257.html
または、早いが少しトリッキーなやつ 1秒未満
MyFile = "text;" & "C:\data.csv"
With ActiveSheet.QueryTables.Add(Connection:=MyFile, ・・・
.Name = "link1"
.TextFileCommaDelimiter = True
.TextFilePlatform = 932
.Refresh
End With
ActiveWorkbook.Names("link1").Delete
-------------------------------------------
■SQLでのCSV読込
同シートに読込むため、大量データには要注意。
同フォルダ内に無くてはならない。
HDR=YESでヘッダーを読み込まなくなる。
WHERE区を指定すねと条件指定抽出OK。
※「参照設定」で「Microsoft ActiveX Data Objects 2.X Library」を追加
ここ参考
https://excel-ubara.com/excelvba5/EXCEL114.html
初期設定
https://excel-ubara.com/excelvba4/EXCEL273.html
SQL
http://www.atmarkit.co.jp/ait/articles/1112/21/news128.html
Sub ReadCsv()
Dim objCn As New ADODB.Connection
Dim objRS As ADODB.Recordset
Dim GYO As Long, COL As Long
Dim strSQL As String
With objCn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Text;HDR=NO"
.Open ThisWorkbook.Path & "\"
End With
strSQL = ""
strSQL = strSQL & " SELECT *"
strSQL = strSQL & " FROM"
strSQL = strSQL & " CSVTEST.csv"
'SELECT ename, hiredate, sal 3カラム指定
'FROM emp; 表の指定
'WHERE 列名 比較演算子 条件値 (WHERE deptno=10;)←どのような条件の行を
'*'KING'; 文字や日時はこうやって指定
'日本語環境での初期設定はRR(年の下2桁)-MM(月)-DD(日)形式
Set objRS = New ADODB.Recordset
Set objRS = objCn.Execute(strSQL)
With Worksheets("CSV")
.UsedRange.ClearContents
.Range("A1").CopyFromRecordset objRS
End With
objCn.Close
Set objRS = Nothing
Set objCn = Nothing
End Sub
―――――――――――――――――――――――――+
ソート! ループ回すと13秒かかる、ソート関数の方が早い。
Selection.Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
―――――――――――――――――――――――――+
コメント
最新を表示する
NG表示方式
NGID一覧