excel VBA について

質問

画像のようにexcelファイルのD列に自動で通番を入力させたい。

フォームを利用して新しいデータは最終行に反映するように設定しています。
できれば、フォームの登録を押した時点でD列最終行に画像条件にあう通番を入力させたいのですがどうすればいいかわかりません。

今は、D列セルにCOUNTIFを使って条件を検索して通番を表示させているのですが、日々行が増え続けるためファイルが非常に重たくなってきたのでマクロにチャレンジしました。

マクロの知識はほとんどありません！
よろしくお願いします。

回答No.6

kkkkkm · ベストアンサー

No5の訂正です。

MyRow = .Range("B" & Rows.Count).End(xlUp).Row + 1

新しい最終行を追加した後にこのコードを追加するので最後の+1は不要でした。

あと、既存の式でカウントされているセルですが、そのセルをコピーしてそのまま「値貼り付け」してしまえば計算しない分軽くなると思います。

お礼

kkkkkmさん
本当にありがとうございます！

最終的にテキスト入力マクロの後に

With Sheets("Sheet2")
MyRowB = .Range("B" & Rows.Count).End(xlUp).Row
MyRowC = .Range("C" & Rows.Count).End(xlUp).Row
MyRowF = .Range("F" & Rows.Count).End(xlUp).Row
If .Range("B" & MyRowB) <> "" Then
.Range("I" & MyRowC) = _
WorksheetFunction.CountIfs(.Range("B:B"), .Range("B" & MyRowB), .Range("C:C"), .Range("C" & MyRowC), .Range("F:F"), .Range("F" & MyRowF))
Else
.Range("I" & MyRowB) = ""
End If
End With

これでSheet2のI列に年月区分の通し番号が自動表示できました！

何度もご回答くださり、本当にありがとうございます。
少しでも軽くなればと思い、値貼り付けはすでに行ってました。

ありがとうございました。
無事解決出来たのでベストアンサー付けときます！

回答No.5

kkkkkm

>　=IF(COUNT(A588)=1,COUNTIFS(B$2:B588,B588,C$2:C588,C588,F$2:F588,F588),IF(A588="","",COUNTIFS(B$2:B588,B588,C$2:C588,C588,F$2:F588,F588)))

上記の式ですが、私が十分理解していない可能性は大で、そのうえあまり回らない頭で考えたのですが

COUNT(A588)=1
この式が数値がどうかの判定に使われているのでしたら

A列が数値ならカウントしなさい
A列が数値以外の場合
未入力なら未入力
未入力でなければ(数値以外が入力されていても)カウントしなさい

という意味ですよね。A列に数値以外が入っていても「未入力でなければカウントしなさい」が最終で有効になりますので数値以外を除外したいのでしたら除外されていないことになります。この式の場合、前半のIFは不要で後半だけの式で結果は同じになると思われます。

以下は、数値以外の除外を考えていないコードです、未入力だけカウントから除外します。

Dim MyRow As Long

With Sheets("Sheet2")
MyRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
If .Range("A" & MyRow) <> "" Then
.Range("I" & MyRow) = _
WorksheetFunction.CountIfs(.Range("B:B"), .Range("B" & MyRow), .Range("C:C"), .Range("C" & MyRow), .Range("F:F"), .Range("F" & MyRow))
Else
.Range("I" & MyRow) = ""
End If
End With

こちらは、数値以外と未入力を除外します

Dim MyRow As Long

With Sheets("Sheet2")
MyRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
If IsNumeric(.Range("A" & MyRow)) And .Range("A" & MyRow) <> "" Then
.Range("I" & MyRow) = _
WorksheetFunction.CountIfs(.Range("B:B"), .Range("B" & MyRow), .Range("C:C"), .Range("C" & MyRow), .Range("F:F"), .Range("F" & MyRow))
Else
.Range("I" & MyRow) = ""
End If
End With

一行ずつ追加していってカウントするかどうかというようなテストはしていませんので、正常に動くかどうかは不明ですが、もしよろしかったらお試しください。

お礼

kkkkkmさん
ありがとうございます＾＾

さっそく試してみます！

回答No.4

kkkkkm

> よろしければ、再度お知恵を貸していただけませんでしょうかm(_ _)m

示されたコードで希望の動作になるのかどうかはこちらではテストできませんが、別シートのセルを参照するときには以下のようにしてください。

Sheet2のセルの場合

With Sheets("Sheet2")

.Range("a1").Value = 1
'↑Rangeの前にドットがあります。ドットのあるRangeだけSheet2のセルの指定となります。ドットがなければシートモジュールでしたらそのシートのセルを、標準モジュールとフォームのモジュールでしたらアクティブなシートのセルの指定となります。

End With

お礼

kkkkkmさん　ご回答いただき、ありがとうございます。

無知な私にはこれ以上無理そうです・・・

もう少し勉強してチャレンジしてみます。

ありがとうございました。

回答No.3

kkkkkm

> 試してみましたがうまくカウントされませんでした。

すみません、画像が小さかったのでよく見えてなくてC列だけをカウントしてました。A列&B列&C列を一塊としてカウントしていってるのですね。WorksheetFunction.CountIfはセルに書きこむCOUNTIF関数と同じですので現状で利用されているD列の式をそのまま応用してみてください。

お礼

返事が遅くなってすいません。
その後も毎日試行錯誤しておりますが・・・うまくいかないもんですね・・・。
元のセルに入っている式は下記です。
今は、この列をオートフィルでコピーしている状態です。
Ｂ列は西暦　Ｃ列は月　Ｆ列は区分　といった内容でカウントしています。（I列に式が入っていて、その年月通し番号が出るようになってます）
利用中の関数：
=IF(COUNT(A588)=1,COUNTIFS(B$2:B588,B588,C$2:C588,C588,F$2:F588,F588),IF(A588="","",COUNTIFS(B$2:B588,B588,C$2:C588,C588,F$2:F588,F588)))

利用中の関数をどのように応用したらよいかわからず、下記内容に至ったのですが別シートで入力しているためRangeがうまく動きません。
Range("I" & Range("C" & Rows.Count).End(xlUp).Row) = WorksheetFunction.CountIfs(Range("B:B"), Range("B" & Range("B" & Rows.Count).End(xlUp).Row), Range("C:C"), Range("C" & Range("C" & Rows.Count).End(xlUp).Row), Range("F:F"), Range("F" & Range("F" & Rows.Count).End(xlUp).Row))
よろしければ、再度お知恵を貸していただけませんでしょうかm(_ _)m
よろしくお願いします。

回答No.2

tom04

こんばんは！

解釈が違っていたらごめんなさい。
A列～C列データが入力されたタイミングで、空白セルがない場合にマクロが動くようにしてみました。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー％＆ペースト　→　Excel画面に戻りA～C列にデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, lastRow As Long
If Intersect(Target, Range("A:C")) Is Nothing Or Target.Count > 1 Then Exit Sub
i = Target.Row
If WorksheetFunction.Count(Cells(i, "A").Resize(, 3)) = 3 Then
Application.ScreenUpdating = False
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A:A").Insert
Range(Cells(2, "A"), Cells(lastRow, "A")).Formula = "=B2&""_""&C2&""_""&D2"
With Range(Cells(2, "E"), Cells(lastRow, "E"))
.Formula = "=COUNTIF(A$2:A2,A2)"
.Value = .Value
End With
Range("A:A").Delete
Application.ScreenUpdating = True
End If
End Sub 'この行まで

こんな感じで良いのでしょうか？

※　関数をそのまま利用しているだけです。m（_ _）m

お礼

返事が遅くなってすいません。
ご回答ありがとうございます。

試してみたのですが、うまくカウントしてくれませんでした。

ありがとうございます。

回答No.1

kkkkkm

> フォームを利用して新しいデータは最終行に反映するように設定しています。

そのコードの最後に

Range("D" & Range("C" & Rows.Count).End(xlUp).Row) = WorksheetFunction.CountIf(Range("C:C"), Range("C" & Range("C" & Rows.Count).End(xlUp).Row))

みたいなコードを入れてください。

お礼

kkkkkmさん
さっそくのご回答ありがとうございます。

試してみましたがうまくカウントされませんでした。

それと伝え忘れていたのですが、D列以降も利用してE列に商品名　F列に金額　といった感じです。