■VBA 値が同じ行が続いていたら、結合させる
どっかの質問コーナーに書いてあったコードを参考に書いたけど、URLロストしてしまった。
とりあえず、動くと思う。
Sub MargeMethod() '値が同じ行が続いていたら、結合させる処理 Dim MargeCol1 As Integer ‘対象はA列 MargeCol1 = 1 Dim lngRowLst As Long Dim lngRowCnt As Long Dim lngRowGrp As Long '値が入っている最終行数を取得 lngRowLst = Cells.SpecialCells(xlCellTypeLastCell).Row '開始行数 lngRowCnt = 2
Do
lngRowGrp = lngRowCnt
Do While Cells(lngRowGrp, MargeCol1).Value = Cells(lngRowCnt + 1, MargeCol1).Value lngRowCnt = lngRowCnt + 1 Loop
'警告を表示させない Application.DisplayAlerts = False '結合 Range(Cells(lngRowGrp, MargeCol1), Cells(lngRowCnt, MargeCol1)).Merge '警告を表示させない設定を元に戻す Application.DisplayAlerts = True
lngRowCnt = lngRowCnt + 1 Loop Until lngRowCnt > lngRowLst End Sub |
世界でいちばん簡単なExcelVBAのe本
スポンサーサイト
■VBA タブ区切りのテキストを読み込む
大量のタブ区切りのテキストファイルをエクセルに読み込む必要があったので、作成。
やりたかったことは...
・ タブごとのテキストファイルを別セルに挿入する
・ フォルダ内の全てテキストを読み込む
・ 読み込んだテキストごとにページを作成する
・ ページ名はテキストファイルの名前にする
で、できたのがコレ。
Sub tabread()
Dim line As Long Dim buf As String Dim tmp As Variant Dim NewWorkSheet As Worksheet Dim Target As String Dim arraycount As Integer
'対象フォルダをセルから取得 Target = Range("B1").Value
Set FS = CreateObject("Scripting.FileSystemObject") Set Fol = FS.GetFolder(Target) Set Fil = Fol.Files
'対象フォルダにあるファイル数だけループ For Each Fx In Fil
'ファイルパスを取得 sFile = Fol
'ファイル名を取得 sFile = Fol + "\" + Fx.Name
'拡張子を除いたファイル名を取得 sheettmp = Split(Fx.Name, ".")
'ファイルごとに新規シートを作成 Set NewWorkSheet = Worksheets.Add() NewWorkSheet.Name = sheettmp(0)
Open sFile For Input As #1
'2行目のセルから取り込む line = 2
'テキストファイルの終端までループ Do Until EOF(1)
Line Input #1, buf
'タブ区切りで配列に取得 tmp = Split(buf, vbTab)
'配列の要素数を取得 arraycount = UBound(tmp)
For counter = 1 To arraycount Cells(line, counter) = tmp(counter - 1) Next counter '次の行へ line = line + 1
Loop Close #1
Next End Sub |
実際は、セルの幅を調整したり、結合したりする機能も実装したけど、汎用的な部分を抽出した。
使った機能メモ。
'書式を整える Dim lngRowLst As Long
'値が入っている最終行を取得 lngRowLst = Cells.SpecialCells(xlCellTypeLastCell).Row
'セルの幅を設定する Range(Cells(4, 1), Cells(4, 1)).ColumnWidth = 45 Range(Cells(4, 2), Cells(4, 5)).ColumnWidth = 15
'値が入っている最終行まで罫線を引く Range(Cells(4, 1), Cells(lngRowLst, 5)).Borders.LineStyle = xlContinuous
'値が入っている最終行まで中央揃えにする(B~Eの範囲) Range(Cells(2, 2), Cells(lngRowLst, 5)).HorizontalAlignment = xlCenter '桁区切りを設定する Range(Cells(4, 2), Cells(lngRowLst, 2)).NumberFormatLocal = "#,###件" Range(Cells(4, 5), Cells(lngRowLst, 2)).NumberFormatLocal = "#,###件"
|
なんだかんだで、エクセルVBA便利っすなぁ。
■VB エポックタイムを取得
現在時刻をエポックタイムに変換したい。
.ぐぐれば一発かなって思ったけど、意外に見つからなかった。
なので、以下の記事を参考に作成。
C#でDateTimeクラスを使って現在のUNIX時間(UNIXタイム)を求める。
http://ameblo.jp/oregano-blog/entry-10445227668.html
同じ .NET なんだから、そんなに差異はないはずだと思ったわけで。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim dtUnixEpoch As Date = New DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) Dim dt As Date = DateTime.Now dt = dt.ToUniversalTime() '現在時刻のDateTimeからUNIXエポック時刻のDateTimeを引く Dim unixtime As Double = (dt.Subtract(dtUnixEpoch).TotalSeconds) ' 必要な変数を宣言する Dim stTarget As String = unixtime.ToString() ' 14文字目まで取得 stTarget = stTarget.Substring(0, 14) ' 文字を表示する MessageBox.Show(stTarget) End Sub |
思った通り、簡単にできた。
現在時刻をエポックタイムに変換して、メッセージダイアログで表示。
stTarget = stTarget.Substring(0, 14)
ここの部分はバグになりそうだけど、テストコードだからとりあえず良しとする。
---
急にVBで書けっていわれても困りますぜ・・・。