Excelマクロで罫線をひきたい。

質問

Access2000からエクスポートした結果のExcel2000のワークシートに、線をひきたいんです。
一番最初のセルはa1と決まっているけど、一番最後のセルは毎回変わってしまうのですが、
このセルを取得するためにはどんなマクロボタンを作成すればいいでしょうか？

ただ本来の希望としては、マクロボタンひとつで、並べ替え＞セルの変更＞罫線、としたいのですけれど。
「セルの変更」というのは、エクスポートしたデータで「ランク」という項目があり、
これに「特・Ａ・Ｂ」という項目があります。
Access上はひとつのフィールドにまとまっているのですが、Excel上では、それぞれ「特・Ａ・Ｂ」という列を作成し、データがあったら、「○」を入れるというようにしたいのです。
（列が増えることになります。）
また「備考1・備考2」がAccess上にあり、これは別フィールドとなっていますが、
今度はExcel上で「備考」としてひとつの列にしたいのです。
（列の減少）
別シートを作成してもかまいません。

このようなことはできるのでしょうか？
せめて罫線だけでもひければ、と思います。
よろしくお願いします。

回答No.4

nishi6

少々長くなっています。

この処理の考えるところは、Accessの出力シートにはマクロを書き込みづらいことです。
簡単にするために、処理用のシートを作ってみました。

処理用シートの内容
　１．新規Bookを開きシートを１枚のみにする。これに結果を書きます。
　２．標準モジュールに下記コードをコピーして貼り付けます。
　　　（ツール→マクロ→Visual basic Editor で挿入→標準モジュール）
　　　このBookは何回でも使えるように別名で保存しておきます。

使用方法は
　３．Access2000からエクスポートしたシートをこのBookにコピーします。
　４．ツール→マクロ→マクロ で『表の整形』を実行します。

質問に書かれていることは取りあえず全てできているはずです。
罫線はCurrentRegionでセル範囲を求め、Bordersコレクションを操作しています。
ソートは例としてA、B列で行っています。書き換えて下さい。
(Excel2000)

ここから（標準モジュールにコピーして貼り付けます）

Sub 表の整形()
　　'*** シート構造を検証
　　If Worksheets.Count <> 2 Then
　　　　MsgBox "シート枚数が処理要件に合致していません。中止します"
　　　　Exit Sub
　　Else
　　　　If Worksheets(1).Name = "変更後" Then
　　　　　　Worksheets(2).Activate
　　　　Else
　　　　　　Worksheets(1).Activate
　　　　End If
　　End If

　　'シートを変数に代入
　　Dim ws1 As Worksheet 'ワークシート(Accessから出したシート)
　　Dim ws2 As Worksheet 'ワークシート(罫線を引くシート)
　　　　Set ws1 = ActiveSheet
　　　　Set ws2 = Worksheets("変更後"): ws2.Range("A1").CurrentRegion.Clear

　　Dim rw As Long '行カウンタ
　　Dim col1 As Integer '列カウンタ1
　　Dim col2 As Integer '列カウンタ2
　　Dim hd As String 'セルの値(表題)
　　Dim dt As String 'セルの値(データ)
　　Dim Biko1, Biko2 As Integer '備考1,2の場所

　　Application.ScreenUpdating = False

　　'*** 表題部分を書き込む ***
　　With ws1
　　　　col2 = 0
　　　　col1 = 1: hd = .Cells(1, col1)
　　　　While hd <> ""
　　　　　　If hd <> "備考2" Then
　　　　　　　　If hd = "ランク" Then '特・Ａ・Ｂの分離
　　　　　　　　　　col2 = col2 + 1: ws2.Cells(1, col2) = "特"
　　　　　　　　　　col2 = col2 + 1: ws2.Cells(1, col2) = "Ａ"
　　　　　　　　　　col2 = col2 + 1: ws2.Cells(1, col2) = "Ｂ"
　　　　　　　　ElseIf hd = "備考1" Then '備考欄は備考1のみ使う
　　　　　　　　　　col2 = col2 + 1: ws2.Cells(1, col2) = "備考"
　　　　　　　　　　Biko1 = col1
　　　　　　　　Else
　　　　　　　　　　col2 = col2 + 1: ws2.Cells(1, col2) = .Cells(1, col1)
　　　　　　　　End If
　　　　　　Else
　　　　　　　　Biko2 = col1
　　　　　　End If

　　　　　　col1 = col1 + 1: hd = .Cells(1, col1)
　　　　Wend
　　End With

　　'*** データ部分を書き込む ***
　　With ws1
　　　　For rw = 2 To ws1.Range("A65536").End(xlUp).Row
　　　　　　col2 = 0
　　　　　　col1 = 1: hd = .Cells(1, col1)
　　　　　　While hd <> ""
　　　　　　　　dt = .Cells(rw, col1)
　　　　　　　　If hd <> "備考2" Then
　　　　　　　　　　If hd = "ランク" Then
　　　　　　　　　　　　Select Case dt '特・Ａ・Ｂの分離
　　　　　　　　　　　　　　Case "特": ws2.Cells(rw, col2 + 1) = "○"
　　　　　　　　　　　　　　Case "Ａ": ws2.Cells(rw, col2 + 2) = "○"
　　　　　　　　　　　　　　Case "Ｂ": ws2.Cells(rw, col2 + 3) = "○"
　　　　　　　　　　　　End Select
　　　　　　　　　　　　col2 = col2 + 3
　　　　　　　　　　ElseIf hd = "備考1" Then '備考1、2を結合
　　　　　　　　　　　　col2 = col2 + 1
　　　　　　　　　　　　ws2.Cells(rw, col2) = _
　　　　　　　　　　　　　　.Cells(rw, col1) & .Cells(rw, col1 + Biko2 - Biko1)
　　　　　　　　　　Else
　　　　　　　　　　　　col2 = col2 + 1
　　　　　　　　　　　　ws2.Cells(rw, col2) = .Cells(rw, col1)
　　　　　　　　　　End If
　　　　　　　　End If

　　　　　　　　col1 = col1 + 1: hd = .Cells(1, col1)
　　　　　　Wend
　　　　Next
　　End With

　　'*** 変更したシートを選択 ***
　　ws2.Activate: Range("A1").Select
　　ActiveCell.CurrentRegion.Select

　　'*** ソート ***　列A、Bの例
　　Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, _
　　　　　　　　　 Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes

　　'*** 罫線を引く(Bordersコレクション) ***
　　Dim ks As Integer 'カウンタ
　　For ks = 7 To 12 'xlEdgeLeft から xlInsideHorizontal
　　　　With Selection.Borders(ks)
　　　　　　.LineStyle = xlContinuous
　　　　　　.Weight = xlThin
　　　　　　.ColorIndex = xlAutomatic
　　　　End With
　　Next

　　ws2.Range("A1").Select
　　Application.ScreenUpdating = True
End Sub

回答No.3

papayuka

こんにちは。

罫線はこんな感じかな？

Sub Test()
　For i = 7 To 12
　　ActiveSheet.UsedRange.Borders(i).LineStyle = 1
　Next i
End Sub

「ランク」フィールドは、データが入ったままで列をコピーし、それぞれの列で○に置換えた後に、○以外を消す処理でいけると思います。

マクロを記録し、書きかえると良いですよ。

回答No.2

imogasi

質問の趣旨を理解できない点が有りますが、
下記道具立てが役に立ちますでしょうか。ご参考に。
（列の削除）Ｆ列の例
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
削除する前に、文字列情報が入っているときは＆で結合し残す列にまとめる。
例　Ｃｅｌｌｓ（３，３）＝Ｃｅｌｌｓ（３，３）　＆　Ｃｅｌｌｓ（３，４）
Ｃ列とＤ列の文字列内容を結合してＣ列へセット。
（罫線を引く）
Range(Cells(1,3),Cells(3,5)).Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
WeightでｘｌＴｈｉｎ＝細線、xlThick＝太線
xlEdgeRight=セルの右側辺、xlEdgeTop＝セルの上辺、
xlEdgeBottom＝セルの底辺、xlEdgeLeft＝セルの左辺
消す時＝ Selection.Borders(xlEdgeLeft).LineStyle = xlNone
（罫線を引く最下行の取得）
ｃ=Range("a1").CurrentRegion.Rows.Count
（最右列の取得）
d=Range("a1").CurrentRegion.Columns.Countなど。
（ソート）
Range("A1:Ｃ6").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub
ソートの条件を変えてマクロの記録を取って、どこがどのように変わるか見てください。
(マクロボタンひとつで）
コマンドボタンをシートに貼りつけ、ダブルクリックし
Private Sub CommandButton1_Click()

End Sub
の間にＶＢＡでプログラムを書く。

回答No.1

coco1

マクロボタン、というよりも、罫線を引くにあたって、末尾セルのアドレスを取得する方法、ということですね？

counta()関数でデータが記録された列数と行数を取得すれば、cells()やindirect()関数で最終セルが計算できるはずです。
作業セルを作ればわかりやすいと思います。

罫線を引く手順については操作を記録させればいいのでそれほど難しくはないと思います。

わかりにくければ、補足を要求してください。

お礼

回答ありがとうございます。

＞counta()関数でデータが記録された列数と行数を取得すれば、cells()やindirect()関数で最終セルが計算できるはずです。

すいません、これはどのようにやったらよいのでしょうか？

マクロというかVBAですと「Range」とかでセルの位置を取得しますよね？
そんな感じでできるのでしょうか？