締切済み

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

  • 困ってます
  • 質問No.297020
  • 閲覧数719
  • ありがとう数2
  • 気になる数0
  • 回答数4
  • コメント数0

お礼率 66% (871/1309)

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

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

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

回答 (全4件)

  • 回答No.4

ベストアンサー率 68% (791/1163)

少々長くなっています。

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

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

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

質問に書かれていることは取りあえず全てできているはずです。
罫線は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 '特・A・Bの分離
          col2 = col2 + 1: ws2.Cells(1, col2) = "特"
          col2 = col2 + 1: ws2.Cells(1, col2) = "A"
          col2 = col2 + 1: ws2.Cells(1, col2) = "B"
        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 '特・A・Bの分離
              Case "特": ws2.Cells(rw, col2 + 1) = "○"
              Case "A": ws2.Cells(rw, col2 + 2) = "○"
              Case "B": 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

ベストアンサー率 45% (1388/3066)

こんにちは。

罫線はこんな感じかな?

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

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

マクロを記録し、書きかえると良いですよ。
  • 回答No.2

ベストアンサー率 28% (4451/15824)

他カテゴリのカテゴリマスター
質問の趣旨を理解できない点が有りますが、
下記道具立てが役に立ちますでしょうか。ご参考に。
(列の削除)F列の例
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
削除する前に、文字列情報が入っているときは&で結合し残す列にまとめる。
例 Cells(3,3)=Cells(3,3) & Cells(3,4)
C列とD列の文字列内容を結合してC列へセット。
(罫線を引く)
Range(Cells(1,3),Cells(3,5)).Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
WeightでxlThin=細線、xlThick=太線
xlEdgeRight=セルの右側辺、xlEdgeTop=セルの上辺、
xlEdgeBottom=セルの底辺、xlEdgeLeft=セルの左辺
消す時= Selection.Borders(xlEdgeLeft).LineStyle = xlNone
(罫線を引く最下行の取得)
c=Range("a1").CurrentRegion.Rows.Count
(最右列の取得)
d=Range("a1").CurrentRegion.Columns.Countなど。
(ソート)
Range("A1:C6").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
の間にVBAでプログラムを書く。
  • 回答No.1

ベストアンサー率 25% (323/1260)

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

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

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

わかりにくければ、補足を要求してください。
お礼コメント
KODAMAR

お礼率 66% (871/1309)

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

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

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

マクロというかVBAですと「Range」とかでセルの位置を取得しますよね?
そんな感じでできるのでしょうか?
投稿日時 - 2002-06-21 19:14:04
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集


感謝指数をマイページで確認!

ピックアップ

ページ先頭へ