EXCELマクロでcell単位で右揃えや中央揃えをする方法
- EXCELで簡単なカード型DBを作成するためのマクロを作成しました。
- 作成したマクロで一覧シートのcellに右揃えや中央揃えを設定したいですが、書式設定をしてもマクロを再起動すると元に戻ってしまいます。
- どなたか良い方法を教えてください。
- ベストアンサー
EXCELのマクロでcell単位で右揃えや中央揃えをする方法?
EXCELで,簡単なカード型DBを作りたいので 以下のような一覧シートを作るマクロを作ったのですが list_sheetのそれぞれのcellに,右揃えとか,中央揃えとかを設定したいのです 一度マクロを動かして,作成後の一覧シートに書式設定で右揃えとかしても, もう一度マクロ起動すると元にもどってしまいます どなたかよい方法を教えてください 以下は,自作マクロの一部です cnt = 0 For ix = 1 To Worksheets.Count Set now_sheet = Worksheets(ix) If now_sheet.Name <> "一覧" And InStr(1, now_sheet.Name, "Sheet") <> 1 Then cnt = cnt + 1 list_sheet.Cells(LINE_OFFSET + cnt, AUTHOR_COLUMN) = now_sheet.Cells(5, 6) list_sheet.Cells(LINE_OFFSET + cnt, DATE_COLUMN) = Format(now_sheet.Cells(5, 2), "yyyy/mm/dd") End If Next ix
- kidx
- お礼率49% (101/204)
- オフィス系ソフト
- 回答数1
- ありがとう数2
- みんなの回答 (1)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。maruru01です。 つまり、マクロ起動前後で位置揃えを保持したいということでしょうか。 それなら、 セルの設定変更前に、位置揃えを格納しておき、設定変更後に位置揃えをし直せばいいのではないでしょうか。 Dim temp As Integer temp = now_sheet.Cells(5, 6).HorizontalAlignment ~セルに対する処理~ now_sheet.Cells(5, 6).HorizontalAlignment = temp という感じで。
関連するQ&A
- EXCELのマクロで一覧表にハイパーリンクを付ける方法?
EXCELで,簡単なカード型DBを作りたいので 以下のような一覧シートを作るマクロを作ったのですが シート名のセルにそのデータセルへのハイパーリンクを設定する方法がわかりません list_sheet.Cells(10 + cnt, 5).HyperLink = now_sheet.name & "!" & A9 とでもすればいいのでしょうか? どなたかよい方法を教えてください 以下は,自作マクロの一部です cnt = 0 For ix = 1 To Worksheets.Count Set now_sheet = Worksheets(ix) If now_sheet.Name <> "一覧" And InStr(1, now_sheet.Name, "Sheet") <> 1 Then cnt = cnt + 1 list_sheet.Cells(10 + cnt, 5) = now_sheet.name list_sheet.Cells(10 + cnt, 5).HorizontalAlignment = xlHAlignCenter list_sheet.Cells(10 + cnt, 6) = Format(now_sheet.Cells(5, 2), "yyyy/mm/dd") End If Next ix
- 締切済み
- オフィス系ソフト
- エクセルのマクロについて教えていただきたいのですが・・・
見積書を作成しているんですが、1枚目のシート(見積書)に明細が書ききれなかった時に、マクロを実行すると、『明細書』と言う名前のシートが(1)~(5)枚目まで追加され、各シートの小計を1枚目のシートに書き出す・・・と言うマクロを作りたいのですが、うまくいかずに困っています>< 追加されるシートの元となる『見積もりマスター』と言うシートがあって、そのシート内でそれぞれのシートの小計は取れるのですが・・・ 下記のマクロの中に何か追加すればうまくいく方法はありますか?? (明細書は追加する時もあれば追加しない時もあってその都度、使う人が、最大5枚まで何枚追加するかを決めるそうです。) Sub Macro1() Dim cnt As Integer Dim wkNum As Double Dim ws As Worksheet For Each ws In Worksheets If Left(ws.Name, 4) = "明細書(" Then If IsNumeric(Mid(ws.Name, 5, 1)) Then wkNum = Val(Mid(ws.Name, 5, 1)) If cnt < wkNum Then cnt = wkNum End If End If End If Next ws If cnt >= 5 Then MsgBox ("明細書シートが既に5枚以上あるため追加できません") Exit Sub Else Sheets("明細マスター").Copy after:=Sheets(Worksheets.Count) ActiveSheet.Name = "明細書(" & cnt + 1 & ")" End If End Sub マクロ自体をあまり理解できてなくて、会社の人や、ここで教えていただいて進めているので、出来ればそのままコピーして使用できるようにしていただけるとありがたいです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルで複数のシートに罫線を引くマクロを教えてください。
エクセルで複数のシートに罫線を引くマクロを教えてください。 エクセルの表を担当者名でシート分割後、空白セル以外に罫線を引きたいのですが 複数シートに罫線を引くマクロを教えてください。 いくつか参考にさせていただき現状以下の様になっています。 元データというシートにAからGまで項目があります PJNo. PJ名 棟No. 棟名 取引先名 書類 担当者 1111 PJ1 10 棟1 取引先1 1 東京 1112 PJ2 11 棟2 取引先2 2 大阪 1113 PJ3 12 棟3 取引先3 3 名古屋 Sub 担当別シート作成() Application.ScreenUpdating = False For i# = 2 To Worksheets("元データ").Cells(2, 2).End(xlDown).Row j# = 1 '検索中の人のシートが既にできているかを判断する。 For Each sheet_name In Worksheets If sheet_name.Name = Worksheets("元データ").Cells(i, 7).Value Then j = 7 Exit For End If Next '検索中の人のシートがない場合、新規に作成する。 If j = 1 Then Worksheets.Add After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Worksheets("元データ").Cells(i, 7).Value For j = 1 To 7 Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value Next j End If 'データのコピー For j = 7 To 1 Step -1 Worksheets(Worksheets("元データ").Cells(i, 7).Value). _ Cells(Worksheets(Worksheets("元データ").Cells(i, 7).Value). _ Cells(65535, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value Next j Next i 'それぞれのシートの列幅を最適化します。 For Each sheet_name In Worksheets sheet_name.Columns("A:G").AutoFit Next '---- Dim c As Range Range("A1").Select Set c = Selection.SpecialCells(xlCellTypeLastCell) Range(Cells(1, "A"), c).Select (省略)以下罫線を引くマクロ End Sub
- ベストアンサー
- オフィス系ソフト
- Excel マクロ
Private Sub Workbook_Open() Dim name As String name = "7月" '//ワークシート名----編集用(本日曜日カラー変更ロジック用----月初変更箇所) Dim week As String Dim Y As Integer Dim X As Integer '//処理(1)-(1) すべての曜日セルの背景を白にする Worksheets(name).Range("A13:M13").Interior.ColorIndex = 19 '白 '//処理(1)-(2) 今日の曜日を取得して色を変更する week = WeekdayName(Weekday(Now), False) '今日の曜日 Y = Worksheets(name).Cells.Find(week).Row X = Worksheets(name).Cells.Find(week).Column Worksheets(name).Cells(Y, X).Interior.ColorIndex = 45 'オレンジ系の色 '//処理(2) 本日日付を取得して色を変更する Dim D As Integer D = Day(TODAY()) '本日の日付 Y = Worksheets(name).Cells.Find(D, LookAt:=xlWhole).Row X = Worksheets(name).Cells.Find(D, LookAt:=xlWhole).Column Worksheets(name).Cells(Y, X).Interior.ColorIndex = 19 ' End Sub 途中なのですが、日付を取得して色を変える というロジックを作っていて 処理(2)からを新しく付け足した時にエラーが起こりました。 内容は「SubまたはFunctionが定義されていません」です。 どうやらD = Day(TODAY())らへんでエラーになっているようなのですが どなたか分かる方教えてください(´・ω・`)(´-ω-`))ぺこり
- ベストアンサー
- Visual Basic
- エクセル2000のマクロにおける、複数シート間のコピー&ペーストについて
閲覧ありがとうございます。 現在、エクセル2000(OS、WIN2KPRO)を用いて、以下のような仕様のマクロを組もうとしています。 1.Sheet1のCommandButton1から実行する。 2.Sheet2のA1セルから、O?セルまでのデータの入っているセルをコピーし、Sheet1のB4セル以下にペーストする。 3.O?セルの?は1000以下の値で変化する。 4.Sheet2のF列には、ユニークキーが入力される為、必ず値が入力されている。 上記の仕様に従い、以下のようなマクロを組みましたが、 > Worksheets("Sheet2").Range(Cells(1, 1), Cells(Line_Num, 15)).Select のラインでエラーが発生します。 激しく独学の為、汚いソースですみません^^; **************************************** Private Sub CommandButton1_Click() Worksheets("Sheet2").Select Worksheets("Sheet2").Activate Dim Line_Num Line_Num = 1000 - WorksheetFunction.CountBlank(Range("F1:F1000")) Worksheets("Sheet2").Range("A1").Select Worksheets("Sheet2").Range(Cells(1, 1), Cells(Line_Num, 15)).Select Worksheets("Sheet2").Range(Cells(1, 1), Cells(Line_Num, 15)).Copy Worksheets("Sheet1").Select Worksheets("Sheet1").Activate Range("B4").Select ActiveSheet.Paste End Sub
- ベストアンサー
- オフィス系ソフト
- Excel 2007 マクロのIF構文について
Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、 必要な情報を転記するマクロです。 下記マクロで実現できているのですが、IF構文が多く もっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたら お教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub
- ベストアンサー
- その他MS Office製品
- 既存のマクロを他のエクセルファイルで使用したい
下記のマクロを使おうと思うと、 このマクロがついたファイルを開いて 他のエクセルファイルを開くのですが使えません。 使おうとするとマクロのついたファイルに戻ってしまいます。 Sub test01() Dim ws As Worksheet For Each ws In Worksheets If ws.Name = "統合シート" Then Else ws.Activate d = ws.Range("A65535").End(xlUp).Row ws.Range(Cells(1, "A"), Cells(d, "C")).Copy Sheets("統合シート").Activate Sheets("統合シート").Range("A65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste End If Next End Sub どこを変えればよいのでしょうか。 教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- ワークシート名を変数に格納する方法
VBA初心者です。ワークシートが5つあり各シートにデータを転記するマクロを作成したいのですがワークシート名を変数にしてループ処理することはできるのでしょうか? 下記はワークシート名"H"にだけ転記するマクロを作成してみましたがこの後がわからず悩んでいます。よろしくお願いします。 Dim データ行 As Integer Dim cnt As Integer Dim データ数 As Integer cnt = 4 データ行 = Cells(Rows.Count, 8).End(xlUp).Row For データ数 = 11 To データ行 If Worksheets("入力").Cells(データ数,1).Value= "2"Then Worksheets("H").Cells(cnt, 6).Value = Worksheets("入力").Cells(データ数, 8).Value Worksheets("H").Cells(cnt, 7).Value = Worksheets("入力").Cells(データ数, 9).Value Worksheets("H").Cells(cnt, 8).Value = Worksheets("入力").Cells(データ数, 27).Value Worksheets("H").Cells(cnt, 9).Value = Worksheets("入力").Cells(データ数, 19).Value Worksheets("H").Cells(cnt, 10).Value = Worksheets("入力").Cells(データ数, 20).Value Worksheets("H").Cells(cnt, 11).Value = Worksheets("入力").Cells(データ数, 21).Value Worksheets("H").Cells(cnt, 12).Value = Worksheets("入力").Cells(データ数, 10).Value Worksheets("H").Cells(cnt, 13).Value = Worksheets("入力").Cells(データ数, 11).Value Worksheets("H").Cells(cnt, 14).Value = Worksheets("入力").Cells(データ数, 22).Value Worksheets("H").Cells(cnt, 15).Value = Worksheets("入力").Cells(データ数, 23).Value cnt = cnt + 1 End If Next データ数
- ベストアンサー
- その他([技術者向] コンピューター)
- エクセルのマクロについて
お手数ですが誰か教えてください! BのデーターをAに集計するマクロを作ったのですが 処理速度とっても遅いのです。 高速で処理する方法はありませんでしょうか? 私が作ったマクロ Sub 集計() Dim Z As Integer Dim i As Integer Dim X As Integer For Z = 2 To 2000 For i = 2 To 2000 For X = 3 To 20 If Worksheets("A").cells(Z, 1) = Worksheets("B").cells(i, 1) And Worksheets("A").cells(1, X) = Worksheets("B").cells(i, 14) Then Worksheets("A").cells(Z, X) = Worksheets("B").cells(i, 16) End If Next X Next i Next Z End Sub どこかが間違っている気がしますがマクロ初心者のため 先に進めません。 どうかご教授よろしくお願い致します。
- 締切済み
- Visual Basic
- エクセルのマクロ(データの出力について)
12345678910・・・・ ← 日付 田中 1 1 1 中村 1 1 鈴木 11111 ・ ・ ・ 上のようになっている表を下記のように変換したいのですが、マクロがうまく書けません。 A B C D E F G H I J K L M 1 2 3 4 5 6 7 ← 日付 田中 中村 田中 鈴木 中村 田中 鈴木 鈴木 鈴木 鈴木 Sub test01() d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row r = Worksheets("Sheet1").Range("IV2").End(xlToLeft).Column k = 4 '新規作成用の行ポインター For j = 2 To r For i = 3 To d If Worksheets("Sheet1").Cells(i, j) = 1 Then Worksheets("新規作成用").Cells(k, 2 * (j - 6)) = Worksheets("Sheet1").Cells(i, 2) k = k + 1 End If Next i Next j End Sub ここまで書いていきづまってしまいました。どなたかご指南ください。
- ベストアンサー
- その他MS Office製品
お礼
大変参考になりました HorizontalAlignment っていう プロパティ名がキーだったんですね HorizontalAlignment でweb検索したら以下の設定値も見つかりました .HorizontalAlignment = xlHAlignCenter .HorizontalAlignment = xlHAlignRight .HorizontalAlignment = xlHAlignLeft ありがとうございました