Excel VBA質問箱 IV

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

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


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

8 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【82332】Wordで塗りつぶしされ文字だけ検索したい...

M

- 24/7/27(土) 20:28 -


	引用なし

	パスワード

Wordで特定の色で塗りつぶしをされた文字だけを検索したいです。
chatGPTに聞いた下記のコードでは、エラーメッセージが出て検索できませんでした。
どこが違うのか、ご教授いただけますと幸いです。

Sub FindShadedText()
　　Dim searchColor As Long
　　Dim rng As Range
　　Dim found As Boolean
　　
　　' 検索する塗りつぶし色を設定（RGB値）
　　searchColor = RGB(255, 255, 0) ' 黄色の例

　　' ドキュメントの全範囲を設定
　　Set rng = ActiveDocument.Content
　　
　　' 範囲の最初に移動
　　rng.Collapse Direction:=wdCollapseStart
　　
　　' 塗りつぶし色を検索
　　found = False
　　Do While rng.Find.Execute(FindText:="", Format:=True)
　　　　If rng.Shading.BackgroundPatternColor = searchColor Then
　　　　　　rng.Select
　　　　　　found = True
　　　　　　Exit Do
　　　　End If
　　　　rng.Collapse Direction:=wdCollapseEnd
　　Loop
　　
　　If Not found Then
　　　　MsgBox "指定された塗りつぶし色のテキストが見つかりませんでした。"
　　End If
End Sub

・ツリー全体表示


	【82331】Re:指定回数分行をコピーして下に挿入する

マナ - 24/7/24(水) 19:26 -


	引用なし

	パスワード

▼迷える羊さん：

Dim ws As Worksheet
Dim k As Long, n As Long

Set ws = Worksheets("Sheet1")
　　
For k = ws.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
　　n = ws.Cells(k, 5).Value
　　If n > 1 Then
　　　　ws.Rows(k).Copy
　　　　ws.Rows(k).Resize(n - 1).Insert
　　End If
Next k

・ツリー全体表示


	【82330】指定回数分行をコピーして下に挿入する

迷える羊 - 24/7/24(水) 12:31 -


	引用なし

	パスワード

いつもお世話になっております。

シートに横並びに同じカテゴリの項目が入っており、
E列でそのカテゴリが何個あるのか数えています。
そしてその個数分縦に並べ直したい、というものです。
ただ、まだ縦に並べる前の段階、
コピーして挿入という箇所すら出来てません、

　　　　E列　F列　　　G列　　　H列
1行目　 3　　いちご　みかん　メロン
2行目　 2　　バナナ　すいか
3行目　 0
4行目　 1　　もも
↓
　　　　E列　F列　　　G列　　　H列
1行目　 3　　いちご
2行目　 3　　みかん
3行目　 3　　メロン
4行目　 2　　バナナ
5行目　 2　　すいか
6行目　 0
7行目　 1　　もも

－－
Dim 数 As Long, i As Long
　　
最終行 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next
For 変数● = 最終行 To 1 Step -1
数 = Worksheets("Sheet1").Range(変数●, 5)
　For i = 0 To 数 - 1
　　Worksheets("Sheet1").Rows(変数●).Copy
　　Worksheets("Sheet1").Rows(変数● + 1).Insert
　Next i
Next 変数●
On Error GoTo 0
－－
どのようにしたら動きますでしょうか？

・ツリー全体表示


	【82329】Re:エラー原因のご教示をお願いいたします

かずこ - 24/6/25(火) 16:37 -


	引用なし

	パスワード

ご返信ありがとうございます。

希望の動作できました。

n と mを足す方の発想ができませんでした(汗)

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

・ツリー全体表示


	【82328】Re:VBAの中でセル範囲を任意に設定する

まっちゃん

- 24/6/25(火) 14:55 -


	引用なし

	パスワード

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

・ツリー全体表示


	【82327】Re:エラー原因のご教示をお願いいたします

マナ - 24/6/25(火) 14:30 -


	引用なし

	パスワード

▼かずこさん：

For n = 1 To maxcol Step 6
　　For m = 1 To 5
　　　　　　lastRow = Cells(Rows.Count, n).End(xlUp).Row
　　　　　　ws.Cells(1, n + m).Resize(18).Cut ws.Cells(lastRow + 2, n)
　　Next m
Next n

・ツリー全体表示


	【82326】Re:VBAの中でセル範囲を任意に設定する

マナ - 24/6/25(火) 14:28 -


	引用なし

	パスワード

▼まっちゃんさん：

>　　ActiveCell.Range("A1:B1").Select

この行を削除してください
>　

・ツリー全体表示


	【82325】VBAの中でセル範囲を任意に設定する

まっちゃん - 24/6/25(火) 12:00 -


	引用なし

	パスワード

「選択した範囲をセル内で中央」の機能をマクロで記録すると、マクロ内で２つのセルを選択すると当然のことながらそれ以上のセルを選択した場合、正しく実行できません。任意のセルを選択して実行できるようにするためには、以下の記述をどのように変えれば良いでしょうか？ご教示ください。

Sub 選択範囲内で中央()
'
' 選択範囲内で中央 Macro
'

'
　　ActiveCell.Range("A1:B1").Select
　　With Selection
　　　　.HorizontalAlignment = xlCenterAcrossSelection
　　　　.VerticalAlignment = xlCenter
　　　　.WrapText = False
　　　　.Orientation = 0
　　　　.AddIndent = False
　　　　.IndentLevel = 0
　　　　.ShrinkToFit = False
　　　　.ReadingOrder = xlContext
　　　　.MergeCells = False
　　End With
End Sub

・ツリー全体表示


	【82324】エラー原因のご教示をお願いいたします

かずこ - 24/6/25(火) 11:21 -


	引用なし

	パスワード

前回と似たような質問で申し訳ないです。

B列からF列までのデータをA列のデータの下に順番にCUTとPASTEを繰り返したいです。

下記の★の部分で、それぞれの基準の列(A,G,M列...)の最終行を下から取得しているつもりなのですが、エラーが出ます。

よろしければエラーの原因を教えていただけないでしょうか。

また、上記を5回繰り返した後、G列で再び繰り返す記述もあわせて教えていただけないでしょうか。

支離滅裂なコードで申し訳ございませんが、よろしくお願いいたします。

maxcol = Worksheets(1).Range("A1").CurrentRegion.Columns.Count

For n = 2 To maxcol　

For m = 1 To 5

★lastRow = Cells(30, n - m).End(xlUp).Row

ws.Cells(1, n).Resize(18).Cut ws.Cells(lastRow + 2, n - m)

Next m

Next n

・ツリー全体表示


	【82323】Re:隣のセルの値と比較して並べ替える

かずこ - 24/6/24(月) 10:19 -


	引用なし

	パスワード

ご返信ありがとうございます。

ご指摘通り修正してみたところ、うまく動作しました。

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

・ツリー全体表示


	【82322】Re:隣のセルの値と比較して並べ替える

マナ - 24/6/21(金) 18:45 -


	引用なし

	パスワード

▼かずこさん：

> ws.Cells(1, j).Resize(12).Cut
> ws.Cells(7, j - 1).PasteSpecial

　↓ １行にまとめる

ws.Cells(1, j).Resize(12).Cut ws.Cells(7, j - 1)

・ツリー全体表示


	【82321】Re:隣のセルの値と比較して並べ替える

かずこ - 24/6/21(金) 16:15 -


	引用なし

	パスワード

ご返信ありがとうございます。

申し訳ないです、列と行が逆になっていました。

教えていただいたコードの

ws.Cells(7, j - 1).PasteSpecialの部分で、

"rangeクラスの pastespecialメソッドが失敗しました"というエラーが出ます。

maxcol = ws.Range("A1").CurrentRegion.Columns.Count

の前に下記のコードがあるのですがこれが影響している可能性はありますか？

よろしくお願いいたします。

worksheets(1).Range("A1").PasteSpecial Transpose:=True

・ツリー全体表示


	【82320】Re:隣のセルの値と比較して並べ替える

マナ - 24/6/20(木) 18:48 -


	引用なし

	パスワード

▼かずこさん：

Cells(行番号, 列番号)　です。

Dim ws As Worksheet
Set ws = Worksheets(1)

maxcol = ws.Range("A1").CurrentRegion.Columns.Count

For j = maxcol To 2　Step -1
　　If Left(ws.Cells(1, j), 6) = Left(ws.Cells(1, j - 1), 6) Then
　　　　ws.Cells(1, j).Resize(12).Cut
　　　　ws.Cells(7, j - 1).PasteSpecial
　　End If
Next

・ツリー全体表示


	【82319】Re:隣のセルの値と比較して並べ替える

かずこ - 24/6/20(木) 18:11 -


	引用なし

	パスワード

すみません、今改めて動かしてみたところ★印ではエラーが出ませんでしたがcutとpasteができておりませんでした。
何か改善点があれば教えていただけますでしょうか。
よろしくお願いいたします。

・ツリー全体表示


	【82318】Re:隣のセルの値と比較して並べ替える

かずこ - 24/6/20(木) 17:56 -


	引用なし

	パスワード

ご返信ありがとうございます。
別の質問と被る部分があるのですが、
下記の★部分でエラーが出てつまずいております。
改善点があればご教示お願いいたします。

maxcol = Worksheets(1).Range("A1").CurrentRegion.Columns.Count

For j = maxcol To 1

If Left(Worksheets(1).Cells(j & "1"), 6) = Left(Worksheets(1).Cells(j - 1 & "1"), 6) Then

Range(Cells(j - 1 & "1"), Cells(j - 1 & "6")).Cut

★Worksheets(1).Cells(j - 1 & "7").Paste

End If

Next j

・ツリー全体表示


	【82317】Re:隣のセルの値と比較して並べ替える

マナ - 24/6/20(木) 16:25 -


	引用なし

	パスワード

▼かずこさん：

右端から順に、文字列比較、切り取り、貼り付け　を繰り返してください。

・ツリー全体表示


	【82316】隣のセルの値と比較して並べ替える

かずこ - 24/6/20(木) 15:08 -


	引用なし

	パスワード

　A　　　　　　　 B　　　　　　　　C　　　　　　　 D　　　　　　　　　　　　　　　　　　　　 1 919-03-1　　　　 A12-02-2　　　　 A12-02-1　　　　A21-03-2　　　　　 2 pus　　　　　　　pus　　　　　　　pus　　　　　　 pus　　　　　　　　　　　　　 3 HOYU7411051　　　SEGU2455712　　　TEMU3908770　　 DJLU2014375　 4 20　3.7　　　　　20　22.62　　　　20　 22.64　　　20　14.74　　 5 TNK (E)　　　　　　　　　　　　　　　　　　　　　　　　 6 6.1/2927　　　　　　　　　　　　　6.1/2588 上記のExcelシートを1行目の???-??-?をもとに並び替えたいと考えています。 (列数はその時々で変動します) 右端から左に向かって一つずつ比較し、比較元のセルの左6文字が比較先のセル左6文字と同じ場合、???-??-?のセル+その下のセル5つを比較先の???-??-?のセル+その下のセル5つの下に移動させたいと考えています。 ※左6文字が同じセルが連続するのは最大3回までありますので、重ねたデータをさらに動かすことがあります。説明がわかりづらかったら申し訳ありませんよろしくお願いいたします。

・ツリー全体表示


	【82315】Re:vba初心者です。間違い箇所を教えてい...

かずこ - 24/6/20(木) 10:56 -


	引用なし

	パスワード

rangeをcellsに変えてみたところエラー解決できました。

お力添えいただきありがとうございます。

・ツリー全体表示


	【82314】Re:vba初心者です。間違い箇所を教えてい...

マナ - 24/6/19(水) 12:04 -


	引用なし

	パスワード

▼かずこさん：

>Range(j & "1")

Cells(行番号, 列番号)　を使う方がわかりやすいのでは？

・ツリー全体表示


	【82313】vba初心者です。間違い箇所を教えていた...

かずこ - 24/6/19(水) 11:01 -


	引用なし

	パスワード

下記は現在作成中のコードの一部なのですが★印の部分で、"実行時エラー '1004'

アプリケーション定義またはオブジェクト定義のエラーです。"が出ます。

エラー原因がわかる方がいらっしゃいましたらご指摘をお願いいたします。

maxcol = Worksheets(1).Range("A1").CurrentRegion.Columns.Count

For j = 1 To maxcol

★If Left(Worksheets(1).Range(j & "1"), 6) = Left(Worksheets(1).Range(j + 1 & "1").Value, 6) Then★

Worksheets(1).Range(j + 1 & "1", j + 1 & "6").Cut

Worksheets(1).Range(j & "7").Paste

End If

Next j

・ツリー全体表示


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

8 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free