Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

57 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81356】Re:A1セルから1が入力されている最右のセ...

マナ - 20/6/11(木) 19:03 -


	引用なし

	パスワード

▼VN さん：

こんな感じのほうが、わかりやすいです。

Set b = Rows(1).Find(what:=a, SearchDirection:=xlPrevious)
If Not b Is Nothing Then
　　Range("A1", b).Font.Color = RGB(255, 0, 0)
End If

・ツリー全体表示


	【81355】Re:A1セルから1が入力されている最右のセ...

マナ - 20/6/11(木) 18:56 -


	引用なし

	パスワード

▼VN さん：

b.Font.Color = RGB(255, 0, 0)

です

・ツリー全体表示


	【81354】A1セルから1が入力されている最右のセル...

VN - 20/6/11(木) 18:44 -


	引用なし

	パスワード

お世話になっております。
当方、VBA初心者です。

ネットでかなり調べたのですが対応方法が分からず、
こちらで質問をさせて頂ければ幸いです。

「A1セルから1が入力されている最右のセルまでを赤く塗る」
ために、下記のプログラムを組みました。

ところが、実行時エラー1004
アプリケーション定義またはオブジェクト定義のエラー
が表示されてしまい、動かない状態です。

おそらく、Findメソッドがうまく動いていないのかと推測しています。
どなたか、解決方法をご教授頂けますと幸いです。
お手数をお掛けします。

Sub 仮()
　　Dim a As Integer, b As Range
　　　　a = 1
　　Set b = Range("A1", Rows(1).Find(what:=a, SearchDirection:=xlPrevious))
　　　　Range(b).Font.Color = RGB(255, 0, 0)
End Sub

・ツリー全体表示


	【81353】Re:横並びのデータを5列毎に貼り付ける

猫ママ - 20/6/11(木) 13:22 -


	引用なし

	パスワード

アドバイスありがとうございます。
頑張ってみます。

▼マナさん：
>▼猫ママさん：
>
>>　　　　　　　　Worksheets("1").Cells(1 + 2, n).Value = 商品
>>　　　　　　　　Worksheets("1").Cells(2 + 2, n).Value = 名前
>
>行番号も列番号のように変数を使えばどうでしょうか。
>例えば、
>m = m + 2
>とするとか。

・ツリー全体表示


	【81352】Re:横並びのデータを5列毎に貼り付ける

マナ - 20/6/11(木) 12:40 -


	引用なし

	パスワード

▼猫ママさん：

>　　　　　　　　Worksheets("1").Cells(1 + 2, n).Value = 商品
>　　　　　　　　Worksheets("1").Cells(2 + 2, n).Value = 名前

行番号も列番号のように変数を使えばどうでしょうか。
例えば、
m = m + 2
とするとか。

・ツリー全体表示


	【81351】Re:横並びのデータを5列毎に貼り付ける

猫ママ - 20/6/11(木) 10:47 -


	引用なし

	パスワード

お世話になります。
Ifで入れてみたのですが、どうもうまく貼り付けません。
どう修正したらいいのでしょうか？
何度も申し訳ございません。

Sub オリジナル()
　　Dim r As Range
　　Dim j As Long, k As Long, i As Long
　　Dim 名前 As String, 商品 As String
　　Dim n As Long
　
　　 Set r = Worksheets("蒟蒻畑").Cells(1).CurrentRegion
　
　　 For j = 2 To r.Rows.Count
　　　　名前 = r.Cells(j, 1).Value
　　　　For k = 2 To r.Columns.Count
　　　　　　商品 = r.Cells(1, k)
　　　　　　For i = 1 To r.Cells(j, k)
　　　　　　　　
　　　　　　　　If n = 4 Then
　　　　　　　　n = 1
　　　　　　　　Worksheets("1").Cells(1 + 2, n).Value = 商品
　　　　　　　　Worksheets("1").Cells(2 + 2, n).Value = 名前
　　　　　　　　Else
　　　　　　　　n = n + 1
　　　　　　　　Worksheets("1").Cells(1, n).Value = 商品
　　　　　　　　Worksheets("1").Cells(2, n).Value = 名前
　　　　　　　　End If
　　　　　　
　　　　　　 Next
　　　　Next
　　Next

End Sub

▼マナさん：
>▼猫ママさん：
>
>>投稿No.81343の続きで、横並びになったデータを3列毎に改行して別シートに
>>貼り付けたいです。
>
>
>以下の部分で、貼り付け先を調整するとよいです。
>3列毎に改行なら、n＝4になったら、n=1とすれば
>列は、1→2→3→1→2→3…となります。
>同時に、行も、それぞれ、+2するとよいです。
>
>>　　　　　　　　n = n + 1
>>　　　　　　　　Worksheets("2").Cells(1, n).Value = 商品
>>　　　　　　　　Worksheets("2").Cells(2, n).Value = 名前
>
>
>>
>＾

・ツリー全体表示


	【81350】Re:横並びのデータを5列毎に貼り付ける

マナ - 20/6/10(水) 20:07 -


	引用なし

	パスワード

▼猫ママさん：

>投稿No.81343の続きで、横並びになったデータを3列毎に改行して別シートに
>貼り付けたいです。

以下の部分で、貼り付け先を調整するとよいです。
3列毎に改行なら、n＝4になったら、n=1とすれば
列は、1→2→3→1→2→3…となります。
同時に、行も、それぞれ、+2するとよいです。

>　　　　　　　　n = n + 1
>　　　　　　　　Worksheets("2").Cells(1, n).Value = 商品
>　　　　　　　　Worksheets("2").Cells(2, n).Value = 名前

>
＾

・ツリー全体表示


	【81349】横並びのデータを5列毎に貼り付ける

猫ママ - 20/6/10(水) 15:35 -


	引用なし

	パスワード

先日はありがとうございました。
投稿No.81343の続きで、横並びになったデータを3列毎に改行して別シートに
貼り付けたいです。

ぶどう　　　　白桃　　　　　オレンジ　もも　　　　もも　　　　　りんご　　　　　　マスカット
山田太郎山田太郎　山田太郎　山田太郎　　　　山田太郎　高橋一郎　高橋一郎　　　　

　　　　　　　　　　　　　　 ↓
ぶどう　　　　白桃　　　　　オレンジ　
山田太郎山田太郎　山田太郎
もも　　　　もも　　　　　りんご　　　　　　
山田太郎　　　　山田太郎　高橋一郎　
マスカット
高橋一郎

お手数お掛け致しますが、どうぞよろしくお願いいたします。

・ツリー全体表示


	【81348】Re:範囲指定ではないセルの一括コピーの...

よろずや - 20/6/9(火) 16:38 -


	引用なし

	パスワード

何をしたいのか今市ですが… Sub test() 　　Dim ary, e, p, sh1, sh2 　　Set sh1 = Worksheets(1) 　　Set sh2 = Worksheets(2) 　　ary = Array("A1=B2", "B3=A2", "C2=C1") 　　For Each e In ary 　　　　p = Split(e, "=") 　　　　sh1.Range(p(0)).Value = sh2.Range(p(1)).Value 　　Next End Sub

・ツリー全体表示


	【81347】範囲指定ではないセルの一括コピーの仕方...

初心者 - 20/6/9(火) 12:25 -


	引用なし

	パスワード

範囲指定(A1:C3)ではなく、
A1,B3,C2といった離れたセルを一括でB2,A2,C1セルに反映させる記述で悩んでいます。
A1,B3,C2の値全てをペースト先のそれぞれのセルに反映させたい訳ではなく、
A1=B2、B3=A2、C2=C1といった処理がしたいです。

Worksheets.Range("A1").Value = Worksheets.Range("B2").Value
Worksheets.Range("B3").Value = Worksheets.Range("A2").Value

といった感じで書けば想定通りには動くのですが、
行数が多くて汚く見えるのでもっと整理する方法はないでしょうか。

・ツリー全体表示


	【81346】Re:横並びの表　数字が入っているセルのみ

猫ママ - 20/6/9(火) 8:23 -


	引用なし

	パスワード

返信ありがとうございました！！！

バッチリです、これで業務がかなり改善出来ます。

もっとVBA勉強します。

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

▼マナさん：
>▼猫ママさん：
>
>配列を使わないほうが、わかりやすかったですね。
>
>Sub test2()
>　　Dim r As Range
>　　Dim j As Long, k As Long, i As Long
>　　Dim 名前 As String, 商品 As String
>　　Dim n As Long
>　　
>　　Set r = Worksheets("1").Cells(1).CurrentRegion
>　　
>　　For j = 2 To r.Rows.Count
>　　　　名前 = r.Cells(j, 1).Value
>　　　　For k = 2 To r.Columns.Count
>　　　　　　商品 = r.Cells(1, k).Value
>　　　　　　For i = 1 To r.Cells(j, k).Value
>　　　　　　　　n = n + 1
>　　　　　　　　Worksheets("2").Cells(1, n).Value = 商品
>　　　　　　　　Worksheets("2").Cells(2, n).Value = 名前
>　　　　　　Next
>　　　　Next
>　　Next
>
>End Sub

・ツリー全体表示


	【81345】Re:横並びの表　数字が入っているセルのみ

マナ - 20/6/8(月) 19:17 -


	引用なし

	パスワード

▼猫ママさん：

配列を使わないほうが、わかりやすかったですね。

Sub test2()
　　Dim r As Range
　　Dim j As Long, k As Long, i As Long
　　Dim 名前 As String, 商品 As String
　　Dim n As Long
　　
　　Set r = Worksheets("1").Cells(1).CurrentRegion
　　
　　For j = 2 To r.Rows.Count
　　　　名前 = r.Cells(j, 1).Value
　　　　For k = 2 To r.Columns.Count
　　　　　　商品 = r.Cells(1, k).Value
　　　　　　For i = 1 To r.Cells(j, k).Value
　　　　　　　　n = n + 1
　　　　　　　　Worksheets("2").Cells(1, n).Value = 商品
　　　　　　　　Worksheets("2").Cells(2, n).Value = 名前
　　　　　　Next
　　　　Next
　　Next

End Sub

・ツリー全体表示


	【81344】Re:横並びの表　数字が入っているセルのみ

マナ - 20/6/8(月) 19:03 -


	引用なし

	パスワード

▼猫ママさん：

>VBA初心者です

こんな感じが、わかりやすいかもしれません。

Sub test()
　　Dim w() As String
　　Dim r As Range
　　Dim j As Long, k As Long, i As Long
　　Dim 名前 As String, 商品 As String
　　Dim n As Long
　　
　　Set r = Cells(1).CurrentRegion
　　
　　For j = 2 To r.Rows.Count
　　　　名前 = r.Cells(j, 1).Value
　　　　For k = 2 To r.Columns.Count
　　　　　　商品 = r.Cells(1, k).Value
　　　　　　For i = 1 To r.Cells(j, k).Value
　　　　　　　　n = n + 1
　　　　　　　　ReDim Preserve w(1 To 2, 1 To n)
　　　　　　　　w(1, n) = 商品
　　　　　　　　w(2, n) = 名前
　　　　　　Next
　　　　Next
　　Next
　　
　　With Worksheets.Add
　　　　.Cells(1).Resize(2, n).Value = w
　　End With
　　
End Sub

・ツリー全体表示


	【81343】横並びの表　数字が入っているセルのみ

猫ママ - 20/6/8(月) 14:57 -


	引用なし

	パスワード

VBA初心者です、どうか教えてください。

　　　　　ぶどう　りんご　　白桃
稲川尚美　　　　　　1　　　　　　　　　　　1
蜂須　汐　　　　　　　　　　　2　　　　　　　1

商品名の下に件数が入っている表があります。件数が入っているセルだけ

ぶどう　　　　　　白桃　　　　　　りんご　　　　りんご　　　　　　白桃
稲川尚美　稲川尚美　蜂須　汐　　　　蜂須　汐　　蜂須　汐

商品名と名前を別シートに貼り付けたいです。2件以上の場合はその件数分連続で
貼り付けたいです。
お手数お掛け致しますがよろしくお願いいたします。

・ツリー全体表示


	【81342】Re:sumifのエラー

ms - 20/6/7(日) 13:43 -


	引用なし

	パスワード

▼BJ さん：
>ああ、
>Sumif 関数はセルを返すわけではないので、Set が出来ない。

ＢＪさん、返信ありがとうございました。
結果、setを使わないで一旦計算結果をシートに出力することにしました。

最後0.5乗するとオーバーフローを起こしてしまっているのですが、
それは改めて質問に挙げることにします。

・ツリー全体表示


	【81341】Re:エラーが表示されたらBeep音で知らせる

pollock - 20/6/5(金) 14:14 -


	引用なし

	パスワード

BJ様

教えて頂いた情報を元に、試行錯誤をしていました。
お陰様で、以下のコードによって「エラーが表示されたらBeep音で知らせる」が叶いました。
プロシージャ名には名前以上の意味と機能が備わっていたのですね。とても勉強になりました。ありがとうございました。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range, i As Integer
　　If Not Intersect(Target, Range("AE17:AE116")) Is Nothing Then
　　　　If Target.Offset(, -7).Value = "***" Then
　　　　Beep
　　　　End If
　　End If
End Sub

・ツリー全体表示


	【81340】Re:sumifのエラー

BJ - 20/6/5(金) 13:14 -


	引用なし

	パスワード

ああ、
Sumif 関数はセルを返すわけではないので、Set が出来ない。

・ツリー全体表示


	【81339】Re:sumifのエラー

ms - 20/6/5(金) 13:01 -


	引用なし

	パスワード

▼BJ さん：
>等幅にすると拡大しなくても見えますね。

これは恥ずかしいミスをしてしまいました。
ご指摘ありがとうございます。

早速、指摘された箇所のWorksheet.functionをworksheetfunctionに直して試してみましたが、.Sumifのところが指摘され、「コンパイルエラー　オブジェクトが必要です」という表示が出てきました…。

これを解決するにはどうしたら良いのでしょうか？

・ツリー全体表示


	【81338】Re:sumifのエラー

BJ - 20/6/5(金) 12:47 -


	引用なし

	パスワード

等幅にすると拡大しなくても見えますね。

・ツリー全体表示


	【81337】Re:sumifのエラー

BJ - 20/6/5(金) 12:04 -


	引用なし

	パスワード

ずれた >Set f = Worksheet.Function.SumIf(Range("F2:F280"), g, Range("H2:H280")) 　　　　 ^^^^^^^^^^^^^^^^^^ 　　　　　　　↑ この部分をメモ帳でもエクセルのセルにでも張り付けて文字を拡大してみてください。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

57 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free