Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13190 / 13644 ツリー ←次へ | 前へ→

【6574】セルに特定の値を入力する りん 03/7/11(金) 11:42 質問
【6580】Re:セルに特定の値を入力する ひで 03/7/11(金) 14:04 回答
【6581】すいません、訂正です。 ひで 03/7/11(金) 14:47 回答
【6597】エラーがでるのですが... りん 03/7/14(月) 11:51 質問
【6598】Re:エラーがでるのですが... Jaka 03/7/14(月) 12:16 回答
【6599】Re:エラーがでるのですが... ひで 03/7/14(月) 13:33 回答
【6602】一行しか表示されません りん 03/7/14(月) 15:18 質問
【6607】Re:一行しか表示されません ひで 03/7/14(月) 17:22 回答
【6608】Re:追記 ひで 03/7/14(月) 17:26 発言
【6628】できました!! りん 03/7/15(火) 17:08 お礼

【6574】セルに特定の値を入力する
質問  りん  - 03/7/11(金) 11:42 -

引用なし
パスワード
   こんにちは。
VBA初心者です。教えてください。

下記のような表で、A1に"<CK3"と入力
されている場合は、その下の行の
E列に"CK30"、"<CK5”と入力されている場合は、
E列に"CK50"と表示させたいのですが
いくつかの条件があります。

1.この表は行数が特定できません。
2.この表には空白の行がいくつか存在します。

--------------------------------
  A   B   C   D   E
1<CK3
2 品番 仕入先 数量 金額  
3 CBC  7005 1000 5000  
4 ATA  2001 2000 6000  
5 HPS  2003 3000 7000  
6
7
8<CK5
9  HGC  2003 1000 5000 
10 HSJ  4003 2000 6000 
11 HBT  5003 3000 7000 

--------------------------------
このような条件で、表示させることは
可能でしょうか?
もしわかれば教えてください。
よろしくお願いします。

【6580】Re:セルに特定の値を入力する
回答  ひで  - 03/7/11(金) 14:04 -

引用なし
パスワード
   ▼りん さん こんにちは

>下記のような表で、A1に"<CK3"と入力
>されている場合は、その下の行の
>E列に"CK30"、"<CK5”と入力されている場合は、
>E列に"CK50"と表示させたいのですが
>いくつかの条件があります。
>
>1.この表は行数が特定できません。
>2.この表には空白の行がいくつか存在します。
>
>--------------------------------
>  A   B   C   D   E
>1<CK3
>2 品番 仕入先 数量 金額  
>3 CBC  7005 1000 5000  
>4 ATA  2001 2000 6000  
>5 HPS  2003 3000 7000  
>6
>7
>8<CK5
>9  HGC  2003 1000 5000 
>10 HSJ  4003 2000 6000 
>11 HBT  5003 3000 7000 
>
>--------------------------------
>このような条件で、表示させることは
>可能でしょうか?
>もしわかれば教えてください。
>よろしくお願いします。


"<CK*"という文字列に"0"をつけただけですが・・

Sub test2()

Dim r As Long, N As Long
Dim acs As String, mj As String

acs = ActiveWorkbook.ActiveSheet.Name
N = Sheets(acs).Range("a" & Rows.Count).End(xlUp).Row

 
For r = 1 To N

If Cells(r, 1).Value Like "<CK*" = True Then

mj = Cells(r, 1).Text
Cells(r + 1, 5) = mj & "0"

End If

Next r

End Sub

こんなんでどうでしょうか?
まとはずれならごめんなさい。

【6581】すいません、訂正です。
回答  ひで  - 03/7/11(金) 14:47 -

引用なし
パスワード
   ▼りん さん すいません

"<CK30"になってました
"CK30" でしたね、よく読んでなかったです(^^;
ごめんなさい。

"<CK3"や"<CK5"がいつも4文字だとして・・

Sub test3()

Dim r As Long, N As Long
Dim acs As String, mj As String

acs = ActiveWorkbook.ActiveSheet.Name
N = Sheets(acs).Range("a" & Rows.Count).End(xlUp).Row

 
For r = 1 To N

If Cells(r, 1).Value Like "<CK*" = True Then

mj = Cells(r, 1).Text
Cells(r + 1, 5) = Right(mj, 3) & "0"

End If

Next r

End Sub

【6597】エラーがでるのですが...
質問  りん  - 03/7/14(月) 11:51 -

引用なし
パスワード
   ひでさん回答ありがとうございます。

教えていただいた式を実際のデータに
あわせて加工してみたのですが、どうも
うまくいきません。

「引数の数が一致していません。または不正な
プロパティを指定しています。」という
エラーがでるのですが...。

a列は実際はc列なので a→c に変えています。
文字を表示させる行は実際にはH列なので、
5→8 に変えています。

また、"<CK3"は実際には間に
空白をたくさん含む文字列なのですが、
これがいけないのでしょうか??
-------------------------------------
Sub test3()

Dim r As Long, N As Long
Dim acs As String, mj As String

acs = ActiveWorkbook.ActiveSheet.Name
N = Sheets(acs).Range("c" & Rows.Count).End

For r = 1 To N
If Cells(r, 3).Value Like "〈           CK*" = True Then

mj = Cells(r, 3).Text
Cells(r + 1, 8) = Right(mj, 3) & "0"

End If

Next r

End Sub

【6598】Re:エラーがでるのですが...
回答  Jaka  - 03/7/14(月) 12:16 -

引用なし
パスワード
   こんにちは。

エラーになった行と、ひでさんが回答されたコードを良く見比べてみてください。

【6599】Re:エラーがでるのですが...
回答  ひで  - 03/7/14(月) 13:33 -

引用なし
パスワード
   ▼Jaka さん りんさん こんにちは。

>エラーになった行と、ひでさんが回答されたコードを良く見比べてみてください。
JaKaさんフォローありがとうございます!

すでにJaKaさんの回答で、りんさんもわかっていると思いますが念のために・・(^^;

>「引数の数が一致していません。または不正な
>プロパティを指定しています。」という
>エラーがでるのですが...。
                             ↓
>N = Sheets(acs).Range("c" & Rows.Count).End
りんさんのコードを試してみました
この行でエラーになります。

私のは・・                        ↓
N = Sheets(acs).Range("c" & Rows.Count).End(xlUp).Row

>また、"<CK3"は実際には間に
>空白をたくさん含む文字列なのですが、
>これがいけないのでしょうか??
上記エラーとは関係ないと思いますが・・

>If Cells(r, 3).Value Like "〈           CK*" = True Then
> "〈           CK" この空白数や記号は固定でしょうか?
"CK"のみで判断がつくのなら
If Cells(r, 3).Value Like "*CK*" = True Then
にしてみてはいかがでしょう。

【6602】一行しか表示されません
質問  りん  - 03/7/14(月) 15:18 -

引用なし
パスワード
   ひでさん、Jakaさんありがとうございます。
ひでさんのご指摘通りに直すと、
E列の一行目に"CK30"や"CK50"と表示
されました。
しかし....
私の質問の仕方が悪かったのでしょうか、
下の行にコピーされないのですが??


-------------------------------
  A   B   C   D   E
1<CK3
2 品番 仕入先 数量 金額  
3 CBC  7005 1000 5000  CK30
4 ATA  2001 2000 6000  
5 HPS  2003 3000 7000  
6
7
8<CK5
9  HGC  2003 1000 5000 CK50
10 HSJ  4003 2000 6000 
11 HBT  5003 3000 7000 

--------------------------------
上記のように上の行にだけ表示されます。
これを品番が入力されている
全ての行に表示させるには
どうしたらよいのでしょうか?

【6607】Re:一行しか表示されません
回答  ひで  - 03/7/14(月) 17:22 -

引用なし
パスワード
   ▼りん さん たびたびです
>ひでさん、Jakaさんありがとうございます。
>ひでさんのご指摘通りに直すと、
>E列の一行目に"CK30"や"CK50"と表示
>されました。
>しかし....
>私の質問の仕方が悪かったのでしょうか、
>下の行にコピーされないのですが??

一つだけでよいと思ってました(^^;

>
>-------------------------------
>  A   B   C   D   E
>1<CK3
>2 品番 仕入先 数量 金額  
>3 CBC  7005 1000 5000  CK30
>4 ATA  2001 2000 6000  
>5 HPS  2003 3000 7000  
>6
>7
>8<CK5
>9  HGC  2003 1000 5000 CK50
>10 HSJ  4003 2000 6000 
>11 HBT  5003 3000 7000 
>
>--------------------------------
>上記のように上の行にだけ表示されます。
>これを品番が入力されている
>全ての行に表示させるには
>どうしたらよいのでしょうか?

これでどうでしょうか・・?

Sub test4()

Dim r As Long, N As Long, i As Long
Dim acs As String, mj As String

acs = ActiveWorkbook.ActiveSheet.Name
N = Sheets(acs).Range("c" & Rows.Count).End(xlUp).Row

i = 0

For r = 1 To N

If Cells(r, 3).Value Like "*CK*" = True Then
mj = Cells(r, 3).Text

Cells(r + 1, 8) = Right(mj, 3) & "0"
Cells(r + 1, 3).Offset(1).Select

Do While Cells(r + 1, 3).Offset(1 + i) <> ""
     Cells(r + 1, 8).Offset(1 + i) = Right(mj, 3) & "0"
i = i + 1
Loop
i = 0

End If

Next r

End Sub

【6608】Re:追記
発言  ひで  - 03/7/14(月) 17:26 -

引用なし
パスワード
   ▼りん さん


>>-------------------------------
>>  A   B   C   D   E
>>1<CK3
>>2 品番 仕入先 数量 金額  
>>3 CBC  7005 1000 5000  CK30
>>4 ATA  2001 2000 6000  
>>5 HPS  2003 3000 7000  
>>6
>>7
>>8<CK5
>>9  HGC  2003 1000 5000 CK50
>>10 HSJ  4003 2000 6000 
>>11 HBT  5003 3000 7000 
>>
品番の行間(A列)に空白が
無いとうまく動きません。
上記の場合は6と7行目が空白なので
OK!

【6628】できました!!
お礼  りん  - 03/7/15(火) 17:08 -

引用なし
パスワード
   ひでさんこんにちは。
回答の通りに入力すると、ちゃんと
できました!

どうもありがとうございました!!

13190 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free