■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で書けっていわれても困りますぜ・・・。