VBA初心者です。プログラム教えてください。

質問

行１にＡ～Ｋの値があり、この範囲で、Ａ列に同じ値が入っている限り１、２、３と始まる値が入るよう処理をする。Ａ列の値が変ったら、また１からスタートする値が入るよう処理をしたい。

Sub Work()

Dim M As Integer
Dim N As Integer

M = 2
N = 2

Do While Cells(2 ,N) <> ""
Cells(3 , N) <> "" Or C = Cells(3 , N - 1)　　(1)
N = N + 1
Loop

End Sub

上記を作りましたが、(1)の所でデバックしてしまいます。
解決策をぜひ教えてください。よろしくお願いします。

回答No.9

Wendy02

こんばんは。

>今回はLoopを使いたかったのですが、とても参考になりました。

原則的に、Loopで、最終行の判定をセル1つずつとれば、遅くなりますので、通常、Do ～Loop は、大量のセルの判定には使いません。少量に限ります。なお、Do ～ Loopの使い方のほうが難しいです。

また、以下のコードでは、本来は、不要ですが、罫線などは、自分以外の環境の時は、極力、プロパティの省略は避けることにしています。しかし、個々の線は、コレクションとしてまとめてよいということです。罫線を使うと、とたんにスピードが遅くなりますから、それなりにコードの工夫は必要です。まあ、後学のために。

'標準モジュール

Sub PlusLineDrawing()
　　Dim c As Range
　　Dim N As Long
　　Dim rng As Range
　　Set rng = Range("A2", Range("A65536").End(xlUp))
　　Application.ScreenUpdating = False
　　'省略は避けます
　　With rng.Offset(, 1).Resize(, 11)
　　　　.Borders.LineStyle = xlNone
　　　　.Borders.LineStyle = xlContinuous
　　　　.Borders.Weight = xlThin
　　　　.Borders.Color = vbBlack
　　End With
　　N = 0
　　For Each c In rng
　　　　c.Offset(, 1).Resize(, 11).FormulaLocal = "=" & N & "+COLUMN(A1)"
　　　　c.Offset(, 1).Resize(, 11).Value = c.Offset(, 1).Resize(, 11).Value
　　　　If StrComp(Trim(c.Value), Trim(c.Offset(1).Value), 1) = 0 Then
　　　　　　N = WorksheetFunction.Max(c.Offset(, 1).Resize(, 11))
　　　　Else
　　　　　　N = 0
　　　　　　'オプション--最後を太線にするか、そのままにするか？
　　　　　　'If c.Row = rng.Cells(rng.Count).Row Then Exit For　'太線
　　　　　　c.Offset(, 1).Resize(, 11).Borders(9).Weight = xlMedium
　　　　End If
　　Next c
　　Set rng = Nothing
　　Application.ScreenUpdating = True
End Sub

お礼

ご丁寧にありがとうございました。もう少し上達して、こちらのプログラムも勉強したいと思います。

回答No.8

Bickyon

#1です。罫線追加バージョンです。

Dim Col As Integer
Dim Col2 As Integer
Dim Line As Long
Dim Cnt As Long

Col = 2
Line = 2
Cnt = 0

Cells.Select
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select

Do While Cells(Line, 1) <> ""
Do While Cells(1, Col) <> ""
Cnt = Cnt + 1
Cells(Line, Col) = Cnt
Col = Col + 1
Col2 = Col
Loop
Line = Line + 1
Col = 2
If Cells(Line, Col - 1) <> Cells(Line - 1, Col - 1) Then
Cnt = 0
Range(Cells(Line - 1, 2), Cells(Line - 1, Col2 - 1)).Borders(xlEdgeBottom).Weight = xlMedium
Else
Range(Cells(Line - 1, 2), Cells(Line - 1, Col2 - 1)).Borders(xlEdgeBottom).Weight = xlThin
End If
Loop

Range(Cells(2, 1), Cells(Line - 1, Col2)).Borders(xlInsideVertical).Weight = xlThin
Range(Cells(2, 2), Cells(Line - 1, Col2 - 1)).Borders(xlEdgeTop).Weight = xlThin
Range(Cells(2, 2), Cells(Line - 1, Col2 - 1)).Borders(xlEdgeBottom).Weight = xlThin

お礼

ありがとうございました。お蔭様で支障なく業務に関われそうです。
また何か問題がありましたら、どうぞ宜しくお願い致します。

回答No.7

Wendy02

こんにちは。

難しく考えないで、数式で作ればよいのではありませんか？
私の場合は、文字の比較に対して、TextCompare を用いています。
Aもa も、全角のＡもａも同じだとします。

Sub NumberingTest1()
Dim c As Range
Dim N As Long

N = 0

For Each c In Range("A2", Range("A65536").End(xlUp))
　c.Offset(, 1).Resize(, 11).FormulaLocal = "=" & N & "+COLUMN(A1)"
　'定数化
　c.Offset(, 1).Resize(, 11).Value = c.Offset(, 1).Resize(, 11).Value
　'文字列比較
　If StrComp(Trim(c.Value), Trim(c.Offset(1).Value), 1) = 0 Then
　　 N = WorksheetFunction.Max(c.Offset(, 1).Resize(, 11))
　Else
　　 N = 0
　End If
Next c
End Sub

お礼

ありがとうございます。今回はLoopを使いたかったのですが、とても参考になりました。Wendy02様の方法は別の機会に参考にさせていただきたいと思います。

回答No.6

Bickyon

#1です。#4氏が既に回答されていますが、私はLoopを使う方法ということで．．．

Dim Col As Integer
Dim Line As Long
Dim Cnt As Long

Col = 2
Line = 2
Cnt = 0

Do While Cells(Line, 1) <> ""
Do While Cells(1, Col) <> ""
Cnt = Cnt + 1
Cells(Line, Col) = Cnt
Col = Col + 1
Loop
Line = Line + 1
Col = 2
If Cells(Line, Col - 1) <> Cells(Line - 1, Col - 1) Then
Cnt = 0
End If
Loop

以上です。

補足

ありがとうございました。思う通りにできました。
また併せて教えていただきたいのですが、罫線を引く場合の設定はどのようにしたらいいのでしょうか。

希望はＢ２セルから値が入ってる部分を細線で格子状にしたいのです。
またＡ１列の値が変る部分（ａとｂの行の境目）を太線にしたいのですが、

With Selection

　Range(Cells(2,Line),Cells(Col,2)).Select

　　Selection.Borders(xlDiagonalDown).LineStyle = xlNone
　　Selection.Borders(xlDiagonalUp).LineStyle = xlNone
　　Selection.Borders(xlEdgeLeft).LineStyle = xlNone
　　Selection.Borders(xlEdgeTop).LineStyle = xlNone
　　Selection.Borders(xlEdgeBottom).LineStyle = xlNone
　　Selection.Borders(xlEdgeRight).LineStyle = xlNone
　　Selection.Borders(xlInsideVertical).LineStyle = xlNone
　　Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End With

では作動しませんでした。よろしくお願いいたします。

回答No.5

papayuka

#3です。

#4さんへの補足＆回答を見て書いています。
回答者はシート内容を見ている訳ではないので、このように座標と結果が視覚的に解ると答えやすいです。

Do ～ Loop を使う方法ではありませんが、参考まで。

Sub Test()
Dim cnt As Long, myRow As Long, myCol As Integer
　'カウント変数を初期化
　cnt = 1
　With ActiveSheet
　　'A2からCtrl+↓のA列最終行までループ
　　For myRow = 2 To .Cells(2, 1).End(xlDown).Row
　　　'B列からL列までループして連番を代入
　　　For myCol = 2 To 12
　　　　 .Cells(myRow, myCol).Value = cnt
　　　　 cnt = cnt + 1
　　　Next myCol
　　　'次の行に移る前にA列の文字を判定し、違っていたらCntを初期化
　　　If .Cells(myRow, 1).Value <> .Cells(myRow + 1, 1).Value Then
　　　　 cnt = 1
　　　End If
　　'次の行へ
　　Next myRow
　End With
End Sub

お礼

参考になります。次の機会にぜひ使わせていただきたいと思います。ありがとうございました。

回答No.4

Bickyon

再度#1です。しつこくて申し訳ないです。
#3氏の補足に書かれたものもみましたが、やはり質問者様の意図するところが見えません。

行１のＡ～Ｋの値というのは、範囲を示しているだけで、ナンバリングの条件には関係ないのですね？
c1とかr1とか新しい情報（条件）も出てきてますので、まだ問題が解決されていないようなら、改めて条件の整理をお願いします。

・Ａ列の値により付与する１、２、３～という値はどのセル（どの列）に入れたいのでしょうか？Ｂ列ですか？
・Ａ列から１列おきにＫ列までaa,bbb,ccって入れてあるから、間の空白列にナンバリングしたいってことですか？

お礼

誤って上記を転送してしまいましたので、こちらに補足させていただきます。

Ａ～Ｋ列はセルＢ１～Ｌ１にあります。また縦方向のａ、ｂ、ｃはＡ２セルから始まります。

　 Ａ　　 Ｂ　　Ｃ　　Ｄ　　 Ｅ　　Ｆ　　Ｇ　　Ｈ　　Ｉ　　Ｊ　　Ｋ
ａ　１　　２　　３　　４　　５　　６　　７　　８　　９　 １０　１１
ａ １２ １３　 １４　１５　１６　１７　１８　１９　２０　　２１　２２
ｂ　１　　２　　３　　４　　５　　６　　７　　８　　９　　１０　１１
ｃ　１　　２　　３　　４　　５　　６　　７　　８　　９　　１０　１１
ｄ　１　　２　　３　　４　　５　　６　　７　　８　　９　 １０　１１
ｄ １２ １３　 １４　１５　１６　１７　１８　１９　２０　　２１　２２

のようにしたいのです。Ａ２セルの値が変ったら数字は１から始まる。
どうぞよろしくご指導ください。

補足

こちらこそ説明不足ですみません。
条件は下記のようになります。

　Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　　Ｉ　　Ｊ　　Ｋ
ａ１　　２　　３　　４　　５　　６　　７　　８　　９　　１０　１１
ａ１２
ｂ
ｂ
ｂ
ｃ
ｄ
・
・
・

回答No.3

papayuka

ご質問に「1行目に A～K の値が入っている」「A列の値が変わったら」とありますが、

　N = 2
　Do While Cells(2 ,N) <> ""
　　 Cells(3 , N) <> "" Or C = Cells(3 , N - 1)

上記コードを見る限り 1行目も A列もほとんど無視して、セル B2 と B3 と A3を起点に処理をしようとしていますね。

B1～I1 に A,A,B,B,B,C,C,C と値があった場合、
B2～I2 に 1,2,1,2,3,1,2,3 と番号を振りたい

のように、セル座標を提示して質問された方が回答者の環境で再現させやすいと思いますよ。
仮に上記の条件だとしたら

Sub Test()
Dim N As Integer, M As Integer
M = 1
With ActiveSheet
　　For N = 2 To .Cells(1, 256).End(xlToLeft).Column
　　　　If .Cells(1, N).Value = .Cells(1, N - 1).Value Then
　　　　　 M = M + 1
　　　　Else
　　　　　 M = 1
　　　　End If
　　　　　 .Cells(2, N).Value = M
　　Next N
End With

End Sub

補足

C1に縦方向にa,a,a,b,bなどを、またR1に横方向にＡ、Ｂ、Ｃと入力したいので、起点はＢ２セルになります。

そのような表現がわかりやすいのですね、ご指摘いただいてありがとうございました。

回答No.2

Bickyon

＃１です。
意味が今一理解できないといったのは、Ａ～Ｋの値が横にならんでいるのか、縦に並んでいるのかです。

「行１にＡ～Ｋの値があり」だと横に並んでいるし、
「Ａ列に同じ値が入っている限り」だと縦に並んでいることになります。
お書きになっているCellsの書き方だと列方向に変数が使われていますので、横方向に並んでいると想定します。

そうすると、以下のコードでＯＫなはずです。

Dim N As Integer

N = 1

Do While Cells(1, N) <> ""
If N = 1 Then
Cells(2, N) = 1
Else
If Cells(1, N) = Cells(1, N - 1) Then
Cells(2, N) = Cells(2, N - 1) + 1
Else
Cells(2, N) = 1
End If
End If
N = N + 1
Loop

ワークシート関数を使うなら、a2セルには初期値として1を入力しておき、B2のセルに=If(b1=a1,a2+1,1)と入力し、それを横にコピーしていけばできます。

補足

説明不足でもうしわけありません。ご指摘の通り、「行１」に横方向にアルファベットをＫまで並べてあります。また「列Ａ」にも上から縦にアルファベットがありまして、こちらはａ、ｂなどの表記にすればよかったのですね。失礼いたしました。

回答No.1

Bickyon

直接の原因は(1)の行が、If ～ Then ～ Else ～ End If の形になっていないからだと思います。
それとＣという変数の宣言や値設定もありませんね。

あと「行１にＡ～Ｋの値があり～～」の意味が今一理解できませんので、ピンとはずれかもしれませんが、
=IF(a2<>a1,1,a1+1)というワークシート関数はダメ？

補足

（１）のCはNの間違いでした。すみません。

Cells(3 , N) <> "" Or N = Cells(3 , N - 1)　です。

ここを

If N <> "" Then

Else

End If

でしょうか。Elseの前と後にはどのような条件を入れたらいいですか？

1行目にA,B,C・・・J,Kまでの値が入っている状態です。説明不足で申し訳ありません。関数を使ったらどのようになるのでしょうか？その場合でもVBAでできますか？