Powered By 画RSS

VBA 値が同じ行を結合させる

■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本
世界でいちばん簡単なExcelVBAのe本
スポンサーサイト

VBA タブ区切りのテキストを読み込む

■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 エポックタイムを取得

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

■スポンサードリンク
■プロフィール

ベタログ

管理人 : ベタログ (Twitterアカウント

思い立ったら、ジャンルを気にせず記事にする。それが自由というものだ。
そんな管理方針。
主に取り扱ってる事:オンラインゲーム(SDGO/Travian/ロードオブナイツ)、プログラミングメモ、ネット小説/書籍の感想/観葉植物など。

■まとめ記事
■カテゴリ
■最新記事
■PICKUP

個人的に押しているモノ


魚里高校ダンジョン部! 藻女神様と行く迷宮甲子園
魚里高校ダンジョン部! 藻女神様と行く迷宮甲子園
■感想記事
これぞ青春エンタメ小説。熱いですよ!

オーバーロード1 不死者の王
オーバーロード1 不死者の王
■感想記事
最強軍団が異世界を蹂躙するファンタジー。Web版も読めますが、凄まじい加筆がされているため、Web版読者も楽しめます。
■お勧め品
■最新コメント
■月別アーカイブ
検索フォーム
リンク