[[20210419094051]]　『VBA_空白セルを探して値を貼り付ける』（YUKI）　ページの最後に飛ぶ

『VBA_空白セルを探して値を貼り付ける』（YUKI）

お世話になります。
ほぼ初心者ですので、丸投げに近い形でたいへん申し訳ありませんがお助けいただけますか。
ボタンを押すと、指定の範囲内で空白を探し、指定のワードを貼り付けるようにしたいのですが、どのようにすればよいかまったくわかりません。

作りたいのは商品に関する表です。毎回商品名を記入するのが大変ですので、ある程度ボタンで自動に入力したいと考えています。

入力したいのは A列から D列、5行目から 15行までです。一応、B列を基準にして、B5から順に下へ空欄セルを探し、空白セルがある列のところに A列に「A社」、B列に「B製品」、C列にケース数量「10」、D列に単価「500」といった具合に決まったワードを入力したいです。入力するワードはプログラム内に書き込むつもりです。
以下が例です。

      A        B        C        D
5    A社     B製品     10       500
6    C社     J製品     20     1,000
7    A社     B製品     10       500
8    D社     S製品     50       100
9    A社     B製品     10       500

わかりにくい説明で申し訳ありません。
何卒よろしくお願いいたします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

それぞれの列にドロップダウンリストを設定したらどうですか。
（jkp） 2021/04/19(月) 10:30

ドロップダウンも作っていますが、製品によって入数や単価が基本的に決まっているため、
ボタンのクリックだけで短時間に入力したいと考えています。
（YUKI） 2021/04/19(月) 10:34

 こんにちは　＾＾
いろいろ、方法は有るのでしょうが、ＶＢＡのお勉強と
言う事であれば。。。その、実用的ではありませんが。
すなおに、コードにすれば。。。下記の様な事かと。。＾＾；
Option Explicit
Sub OneInstanceMain()
    Dim i As Long
    Dim r As Range
    With Worksheets("Sheet1")
        Set r = .Range("A5:D15")
    End With
    For i = 1 To r.Rows.Count
        If r(i, 2) = "" Then
            r(i, 1).Resize(, 4) = Array("A社", "B製品", 10, 500)
        End If
    Next
    Set r = Nothing
End Sub
（隠居じーさん） 2021/04/19(月) 10:38

＞決まったワードを入力したいです。
「A社」、B列に「B製品」、C列にケース数量「10」、D列に単価「500」でセットということでしたか。
失礼しました。
（jkp） 2021/04/19(月) 10:48

御隠居さま、ありがとうございます。説明がわるかったのですが、頂戴したもので試したところ、A5:D15が空欄の時はその 11行すべてが記入されてしまいます。記入したいのは常に 1行だけです。
ところでこの方法はあまり実用的ではないでしょうか。熟練者はどのような仕組みを考えるものでしょうか。
実際には商品の内容が様々あり、細かく分ければ数百種類の商品があります。けれどもそれでは登録が大変なので、20種類ほどの類型に分け、それで今回のようなマクロを組み、足りないワードは後から入力しようと思っています。

jkp様、ありがとうございます。説明不足で申し訳ございません。
（YUKI） 2021/04/19(月) 16:47

 >熟練者はどのような仕組みを考えるものでしょうか。

 見かけだけ考えないで、セル操作のコードもかけないようでは。。。
 速度見栄えはその後。
（ｖｂ） 2021/04/19(月) 16:57

 こんばんは　＾＾
いや～。。。すこぉし変だなぁ。。。とは思ったのですが。。
その、何をなさりたいのか。想像がつきませんで。実用的ではないと
書きました。←　多分お望みのものではないだろうという意味です＾＾；
m(__)m
何かの参考にでもと思い、アップ致しました。
jkp　さんのご案内の方が、おやりになりたいことに近いのでは。
大変でも200種類、登録すれば、後は楽になりますよ

↑

 方々からコピペで貼り付けて、データー　→　重複の削除
とかでやれば、そんなにお手間ではないかも。。。m(__)m
情報にアクセスする規則性があれば、もちろん、マクロでも
可能です。でわm(__)m

（隠居じーさん） 2021/04/19(月) 17:43

質問1

A5:D15が空欄の時は、一番上の行に記入出来ればよいのでしょうか？

質問2

実際には商品の内容が様々あり、細かく分ければ数百種類の商品がありますが
納品先のA社～D社も4社ではないということですよね？多分...数十社以上かと？

あくまでイメージだけですが

★空白行を探す

Dim Rx As Long
Rx = IIf(Range("D5").Value = "", 1, Range("D5").End(xlDown).Row + 1)

★別のシートから転記例

Dim Sh1 As Worksheet: Set Sh1 = Workbooks("納品仮名.xlsm").Worksheets("Sheet1")
Dim myRow As Long: myRow = Rx

With Sh1

 .Range("A" & myRow & ":D" & myRow).FormulaR1C1 = 転記("A社、製品、数量、単価").FormulaR1C1          
End With

★ユーザーフォームのオプションボタンから選択又は、ドロップダウンなどを使用する

Dim OptionAry As Variant
Dim f As Boolean
Dim i As Integer
Dim j As Integer
Dim h As Integer

OptionAry = Array(OptionButton1, OptionButton2, OptionButton3, OptionButton4, OptionButton5, OptionButton6, _
OptionButton7, OptionButton8, OptionButton9, OptionButton10, OptionButton11, OptionButton12)

    f = False
    For i = 0 To UBound(OptionAry)
    If OptionAry(i).Value Then
    f = True
    Exit For: End If: Next

If f Then
Sheets("Sheet1").Range("D5").Value = OptionAry(i).Caption

まだまだ続くが、眠気が限界です。笑

※空白行を探して転記するボタンと、最終行を探して転記できた方が便利な気がしますが...
（にゃん） 2021/04/20(火) 01:21

にゃんさん、誠にありがとうございます。十分睡眠は取れましたでしょうか。
[質問 1]はおっしゃる通りで、A5:D15が空欄の時に、一番上の行だけ記入出来ればよいです。上から空欄をの行を探していって、一番上の空欄の 1行に指定のワードを入力したいです。
提示した商品の明細は実際のイメージとは異なるのですが、商品の組み合わせは数百種類い及ぶため、大まかにグループ分けして 30種類ぐらいに絞ろうと思っています。
別シートからの転記でもよいかなと思いましたが、30種類ほどであればコードに書き込んでもよいと思いました。
（YUKI） 2021/04/20(火) 09:14

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'A5～D15の中のセルをダブルクリックしたら範囲内の一番上の空白行を選択するマクロ
        Dim rng As Range
        Dim rw  As Range
        Set rng = Range("A5:D15")
        If Not Intersect(Target, rng) Is Nothing Then
            Cancel = True
            For Each rw In rng.Rows
                If WorksheetFunction.CountA(rw) < 1 Then
                    rw.Select
                    Exit Sub
                End If
            Next
            MsgBox "空白行無し", vbInformation
        End If
    End Sub

（参考） 2021/04/20(火) 09:23

申し訳ないのですがすでに見失っております。ボタンひとつでの作業はむつかしいのでしょうか。
（YUKI） 2021/04/20(火) 13:58

 ＞＞ボタンひとつでの作業はむつかしいのでしょうか。
いえ、出来ると思いますが。
１．加工元の表情報　：数百種類の商品のシート、セル番地情報
２．どれとどれを処理：プログラムに書き込む予定の商品、１０件分若しくは作表したい商品全件
３．結果の表　　　　：完成図
をご提示いただければ、お手伝い出来るかもしれませんです。＾＾；

     ↑
 多分。。。。。

 m(__)m
（隠居じーさん） 2021/04/20(火) 14:39

誠に恐縮です。本当にありがとうございます。

完成形は、最初の通り以下の感じです。
========================================

      A        B        C        D
5    A社     B製品     10       500
6    C社     J製品     20     1,000
7    A社     B製品     10       500
8    D社     S製品     50       100
9    A社     B製品     10       500
========================================

1件作っていただければ後はこちらで作りこみます。(せめてそのぐらいは。。)

御隠居様に最初に作成していただいたコードですと
"A5:D15"が空欄の場合はすべて埋まってしまいます。
希望は、ボタン 1回で 1行追加です。
上の表でいいますと、今は 9行目まで記入されてますので、
例えば次に「A社/B製品」ボタンを押すと、
========================================

      A        B        C        D
5    A社     B製品     10       500
6    C社     J製品     20     1,000
7    A社     B製品     10       500
8    D社     S製品     50       100
9    A社     B製品     10       500
10   A社     B製品     10       500
========================================
と追加される感じです。
いかがでしょうか。
（YUKI） 2021/04/20(火) 14:52

 こんにちは　＾＾
はい。おっしゃっている事は解るのですが。
あと、残りの5行は何を、何処から持ってくるのかを
お聞きいたしております。m(__)m
（隠居じーさん） 2021/04/20(火) 15:19

隠居じーさんさんのコードに、1行追加すればよろしいかと。
（書き込んだら、終了するように）
（余計なお世話） 2021/04/20(火) 15:22

 こんにちは　＾＾
すでに、ご案内があったようですが、かぶりましたが、そのまま。。。m(__)m
 A社     B製品     10       500
固定で、1件書込みで。。。よろしいので＾＾；
でしたら、私のコードで、書込んだら
Exit　For
で抜ければ、1件書込みになりますです。[A社     B製品     10       500]、固定
m(__)m
（隠居じーさん） 2021/04/20(火) 15:26

そのですね、、Exit For で抜ける、というのがわかりません。(-_-;)
（YUKI） 2021/04/20(火) 15:43

 こんにちは　＾＾
For i = 1 To r.Rows.Count
    If r(i, 2) = "" Then
        r(i, 1).Resize(, 4) = Array("A社", "B製品", 10, 500)
        Exit For
    End If
Next
のように。。。でしょうか。。。ほんとにこれでよいのかなぁ～。。。(￣▽￣)
でわ。m(__)m
（隠居じーさん） 2021/04/20(火) 15:57

あ、丁度いま自分でも修正してできました。勝手に達成感を味わってました。
多分これで当面は大丈夫です。どうもありがとうございました。
かなり感謝しております。
隠居であるのか隠遁であるのかわかりませんがその御知恵を
まだまだ活用していただければと思います。
またお力添えいただければ幸いです。
繰り返しになりますが誠にありがとうございました!

（YUKI） 2021/04/20(火) 16:02

解決したみたいですね(^^)
（にゃん） 2021/04/20(火) 18:59

にゃんさんもありがとうございました。
他シートからの転記やフォームの利用は次のステップで考えております。
(^^)/
（YUKI） 2021/04/21(水) 15:37

コメント返信：

[ 一覧(最新更新順) ]

[[20210419094051]] 『VBA_空白セルを探して値を貼り付ける』（YUKI） ページの最後に飛ぶ

[[20210419094051]]　『VBA_空白セルを探して値を貼り付ける』（YUKI）　ページの最後に飛ぶ