社会人&学生におすすめする色彩検定の勉強術

こんにちは、先日教えて貰い上手くいっていましたが、チェック漏れで2行あるとうまくいきますが、1行では上手くいかなかったのを確認が漏れていました。1行でも上手く追加させたいと思います。
リストボックスで選択して最終行に1行追加する。2行あるb商品は上手くいきますが、1行のa商品は上手く追加されません。お忙しいところすいません。
Private Sub CommandButton1_Click()

Dim zaiko As String
Dim r As Range, C As Range
zaiko = ListBox1.List(ListBox1.ListIndex, 0)
With ActiveSheet
Set r = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) _
.Find(What:=zaiko, LookIn:=xlValues, LookAt:=xlWhole, After:=Cells(Rows.Count, 1).End(xlUp))
End With
If Not r Is Nothing Then
With r.End(xlDown)
.Resize(, 4).Copy
.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False
For Each C In .Offset(1, 1).Resize(1, 3)
If Not C.HasFormula Then C.Value = ""
Next

End With
End If
End Sub

「excel でグループの最後に行を追加。」の質問画像
教えて!goo グレード

A 回答 (3件)

こういうことでしょうか。


Findの使用をやめました。

Private Sub CommandButton1_Click()
Dim zaiko As String
Dim wrow As Long
Dim maxrow As Long
Dim ws As Worksheet
Dim erow As Long
Dim C As Range
Set ws = ActiveSheet
zaiko = ListBox1.List(ListBox1.ListIndex, 0)
maxrow = ws.Cells(Rows.count, "A").End(xlUp).Row 'sheetの最大行取得
erow = 0
For wrow = 2 To maxrow
If ws.Cells(wrow, "A").Value = zaiko Then
erow = wrow
End If
Next
If erow = 0 Then Exit Sub
With ws.Cells(erow, "A")
.Resize(, 4).Copy
.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False
For Each C In .Offset(1, 1).Resize(1, 3)
If Not C.HasFormula Then C.Value = ""
Next
End With
End Sub
    • good
    • 1
この回答へのお礼

ありがとうございました。上手く使えそうです。

お礼日時:2022/06/14 16:18

2行あれば動くのなら、ダミーデータでも置いておけば良いのでは?


それでとりあえず動くでしょう。
    • good
    • 0

こんにちは



相変わらず、なさりたいことを示さない質問だし、履歴も非公開にしてるし・・

多分これ。
https://oshiete.goo.ne.jp/qa/12962263.html

もう何度も書いているので、繰り返しませんけれど。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング