カテゴリ:マクロ( 42 )

目次シートの作成

シート数が増えていくと、ブックの中から目的のシートを探すのが面倒くさくなってくる。
そんなときは、目次などを作ってハイパーリンクさせると便利だ。

Sub 目次作成()
Dim mysheet As Worksheet
Dim i As Integer

 For Each mysheet In Worksheets
   If mysheet.Name = "目次シート" Then
      Application.DisplayAlerts = False
         mysheet.Delete
      Application.DisplayAlerts = True
   End If
 Next
  Worksheets.Add before:=Worksheets(1)
  ActiveSheet.Name = "目次シート"

 For i = 2 To Worksheets.Count
   Cells(i - 1, 1).Value = Sheets(i).Name
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i - 1, 1), Address:="", _
    SubAddress:=Cells(i - 1, 1).Value & "!" & "A1"
 Next
End Sub
e0080122_13105340.gif

[PR]
by slayer0210 | 2005-11-17 13:12 | マクロ

同じ値の入力及び削除

以前に同じ値のセルを結合する結合したセルを解除して同値を入力でも紹介したが
今回はセル結合なして、同値を入力したり削除したりするマクロを一つ。
e0080122_7395898.gif

上図のようにするためには
 Sub 上と同じ値を入力()
   Dim i As Integer
   Dim gyou As Integer
   gyou = ActiveSheet.UsedRange.Rows.Count - 1
     For i = 2 To gyou
       With Cells(i, 1)
         If .Value = "" Then
            .Value = .Offset(-1).Value
         End If
      End With
    Next
 End Sub
こんな感じだろうか・・・(自信ないが)

また、逆に上のセルと同値の場合は値を削除するマクロは
 Sub 上と同じ値は削除()
  Dim i As Integer
  Dim gyou As Integer
  gyou = ActiveSheet.UsedRange.Rows.Count - 1
    For i = gyou To 1 Step -1
      With Cells(i, 1)
        If .Value = .Offset(1).Value Then
           .Offset(1).Value = ""
        End If
      End With
   Next
 End Sub
e0080122_747244.gif

[PR]
by slayer0210 | 2005-11-17 07:48 | マクロ

色付きセルの行ごと削除

e0080122_14222048.gif

任意の色で塗りつぶされたセルがあって、塗りつぶされたセルが存在する行を削除するマクロ。

Sub 行削除()
Dim r As Integer
Dim c As Integer

For c = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
    If Cells(r, c).Interior.ColorIndex <> xlNone Then
       Rows(r).Delete
    End If
  Next
Next
End Sub

二重ループにしてみたが、なんだか大げさすぎる気もする。

ちなみに、以下の方法では、色付きセルがそのまま取り残された場合が多発。
Dim myrange As Range
For Each myrange In ActiveSheet.UsedRange
  If myrange.Interior.ColorIndex <> xlNone Then
    myrange.EntireRow.Delete
  End If
Next
失敗したことを繰り返さないためにも、あえて晒してみる。
[PR]
by slayer0210 | 2005-11-10 14:31 | マクロ

重複データ削除

e0080122_133884.gif

上図のように、重複するデータがあって(会員番号を昇順で並べ替え後)、行ごと削除するマクロ。

Sub 行削除()
Dim i As Integer
'会員番号を基準にした
For i = ActiveSheet.Range("A65536").End(xlUp).Row To 2 Step -1
   With Cells(i, 1)
     If .Value = .Offset(-1).Value Then
        .EntireRow.Delete
      End If
    End With
Next
End Sub

今のところは、これで動いてる。データ型はLongの方が無難だとは思うけど・・・。
[PR]
by slayer0210 | 2005-11-10 13:48 | マクロ

セルの結合を解除して同じ値を入力

以前に同じ列にある同値を結合するマクロを作ってみたが
今回は、結合したセルを解除してそのセルの値を入力するマクロを作ってみた。

Sub セルの結合を解除して同じ値を入力()
Dim mydate As Date
Range("B3").Activate

Do Until ActiveCell = ""
  mydate = ActiveCell.Value
     If ActiveCell.MergeCells Then
        ActiveCell.UnMerge
        Selection.Value = mydate
     Else
          ActiveCell.Offset(1).Activate
      End If
Loop
End Sub

かなり頼りない感じもするが、一応は目的の結果が得られた。
e0080122_1352369.gif

[PR]
by slayer0210 | 2005-11-04 14:00 | マクロ

数式を消して貼り付ける

作った表に数式が入っている場合、数式を削除して値に置き換え貼り付けたい時は
一般機能の『形式を選択して貼り付け』を選べば良いのだが、その中で『値』と『書式』を選択するのは少し面倒なので、このようなマクロを作ってみました。

Sub test()
With Selection
.Copy Destination:=.Offset(.Rows.Count + 1)
.Offset(.Rows.Count + 1).Value = .Value

End With
End Sub

e0080122_22541127.gif

[PR]
by slayer0210 | 2005-11-01 22:57 | マクロ

赤色の数を数える

数えたい選択範囲を指定してから実行するマクロだが
赤色の数を数えたくて作成してみました。

Sub 赤色を数える()

Dim i As Integer
Dim j As Integer
Dim 赤色数 As Integer
 赤色数=0

For j = 1 To Selection.Columns.Count
   For i = 1 To Selection.Rows.Count
      If Selection.Cells(i, j).Interior.ColorIndex = 3 Then
         赤色数 = 赤色数 + 1
     End If
  Next
Next
    MsgBox 赤色数
End Sub
[PR]
by slayer0210 | 2005-10-28 12:57 | マクロ

行方向の同じ値のセルを結合する

例えばA列に日付などが入っているデータがあったとして
下方向に同じデータが入っているセルを結合するマクロを作ってみた。(自信ないけど・・・)


Sub セル結合()
Dim r As Integer '行数
Dim i As Integer 'カウンタ
r = Sheets(1).Range("a1").CurrentRegion.Rows.Count - 1

Application.DisplayAlerts = False

For i = 2 To r
  Cells(i, 1).Activate '項目の一つ下のセルをアクティブに
    If ActiveCell.Value = ActiveCell.Offset(1).Value Then
         Range(ActiveCell, ActiveCell.Offset(1)).Merge
     End If
Next
Application.DisplayAlerts = True
End Sub
目的の結果は得られたが、いまいちスッキリしない・・・
e0080122_2158663.gif
[PR]
by slayer0210 | 2005-10-26 21:56 | マクロ

ファイル名を指定してアクティブシートのみ保存

以前にブック内のシート名をファイル名にして保存するとうものがあったが
今回は、任意のファイル名(例えばセルに記入されてる文字列)をつけて
アクティブシートのみを保存するマクロを紹介。
今回もD直下に保存してみたが、相変わらず雑だなぁ~~と。

e0080122_1233146.gif
[PR]
by slayer0210 | 2005-10-25 12:32 | マクロ

連続データ作成

任意の範囲内での連番を作成したかったので、下図のようなフォームを作成しました。
e0080122_8393251.gif

そもそも一般機能にも『連続データの作成』というものが存在するのですが
自分にとって多少使い勝手が悪かったようで・・・
ドラッグした範囲内での連番を作成できるようにしたので少しは便利かと。
[PR]
by slayer0210 | 2005-10-21 08:45 | マクロ