Excel VBA質問箱 IV

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

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


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

3 / 3837 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【82365】PDFに一括で個別パスワードを設定

PDF - 24/9/10(火) 9:33 -


	引用なし

	パスワード

500ファイルほどのPDFに個別でパスワードを設定したいです。
PDFのアクションウィザードでは、
同じパスワードでの設定はできたのですが、
個別にパスワードを設定したいので、
やり方をご存知でしたらご教示ください。
印刷可
変更はパスワードをかけたいです。
よろしくお願いします。

・ツリー全体表示


	【82364】Re:カウント数分の行を別シートに挿入し...

ぺろ - 24/9/5(木) 9:27 -


	引用なし

	パスワード

▼マナさん：

ご教示ありがとうございます。
書籍等で調べても参考となるものが無く困っておりました。
教えていただいた関数で無事動作しました。
ありがとうございました。

・ツリー全体表示


	【82363】Re:カウント数分の行を別シートに挿入し...

マナ - 24/9/5(木) 8:24 -


	引用なし

	パスワード

▼ぺろさん：

Sub test()
　　 Dim n As Long
　　 s
　　 n = Sheets("sheet2").Range("A2").Value
　　 If n > 0 Then Sheets("Sheet1").Rows(挿入先の行暗号).Resize(n).Insert
　　
End Sub

・ツリー全体表示


	【82362】カウント数分の行を別シートに挿入したい

ぺろ - 24/9/3(火) 18:37 -


	引用なし

	パスワード

以下内容でご教授いただきたく質問させていただきます。

行いたい事
シート２のセルA2にカウント関数で数量をカウント、
シート２でカウントした数をシート１へ行として挿入を行う。

カウント関数以降の手段が思いつかない為質問させていただきました。
仕様に関してアドバイスの程、よろしくお願いいたします。

・ツリー全体表示


	【82361】Re:コピーしたデータを空白セルに追加し...

すぺぺぺ - 24/8/27(火) 10:58 -


	引用なし

	パスワード

▼マナ様：

ご教授頂きましたデータを使用したところ思った通りの動作となりました！
ありがとうございました。

・ツリー全体表示


	【82360】Re:コピーしたデータを空白セルに追加し...

マナ - 24/8/26(月) 22:09 -


	引用なし

	パスワード

▼すぺぺぺさん： >'ws2の貼り付け位置 >x = ws2.Range("A1").End(xlDown).Row >If x = Rows.Count Then x = 1 Else x = x + 1 入力済みデータの個数をカウントしてはどうでしょうか x = WorksheetFunction.CountA(ws2.Columns("A")) + 1

・ツリー全体表示


	【82359】コピーしたデータを空白セルに追加してい...

すぺぺぺ - 24/8/26(月) 21:12 -


	引用なし

	パスワード

下記内容ご教授頂けましたら幸いです。

データの転記を行いたいのですが、コピー先のシートへの転記が思ったように行えず質問させて頂きました。
コピー先の貼り付け位置の取得がうまくできず、数値入力が行えているセルに数値が上書きされてしまう状態です。
データを転記する度に下段のセルにデータが入力されるようにしたいのですが、WS2の貼り付け位置の指示をどのように行えば思ったように入力されるでしょうか。

Sub データ転記()
'シートを変数にセット
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("コピー元")
Set ws2 = Worksheets("コピー先")

'ws2の貼り付け位置
x = ws2.Range("A1").End(xlDown).Row
If x = Rows.Count Then x = 1 Else x = x + 1

ws1.Range("H3").Copy
ws2.Range("A" & x).PasteSpecial xlPasteValues

ws1.Range("B3").Copy
ws2.Range("B" & x).PasteSpecial xlPasteValues

ws1.Range("C15").Copy
ws2.Range("C" & x).PasteSpecial xlPasteValues

'コピー指定解除
　　Application.CutCopyMode = False

End Sub

・ツリー全体表示


	【82358】Re:ピボットテーブルを別シートに転記

かずこ - 24/8/26(月) 10:16 -


	引用なし

	パスワード

▼マナさん：
>▼かずこさん：
>
>貼り付け先に、ピボットテーブルが存在していませんか

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

すみません、ピボットテーブルの削除を繰り返し処理に変えてみたところうまく動作しました。

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

・ツリー全体表示


	【82357】Re:ピボットテーブルを別シートに転記

マナ - 24/8/23(金) 18:26 -


	引用なし

	パスワード

▼かずこさん：

貼り付け先に、ピボットテーブルが存在していませんか

・ツリー全体表示


	【82356】ピボットテーブルを別シートに転記

かずこ

- 24/8/23(金) 14:18 -


	引用なし

	パスワード

ピボットテーブルの別シートへのコピー＆ペーストで苦戦しています。
下記コードを実行するとエラーで'1004'「ピボットテーブルに影響するため、選択したセルに対してこの変更を行うことができません。レポートを～」がでます。
お手数をおかけしますがいいコードがあればご教示お願いいたします。

Worksheets(2).PivotTables(1).TableRange2.Copy Worksheets(1).Range("B27")

・ツリー全体表示


	【82355】Re:セル内重複文字削除

マクロ勉強中です。。 - 24/8/21(水) 20:18 -


	引用なし

	パスワード

▼マナさん：

正常に動作致しました。
長々とお付き合いいただき、ありがとうございました！

・ツリー全体表示


	【82354】Re:セル内重複文字削除

マナ - 24/8/20(火) 19:49 -


	引用なし

	パスワード

▼マクロ勉強中です。。さん：

Sub test5()
　　Dim r As Range, c As Range
　　Dim v() As String, e
　　Dim s1 As String, s2 As String, s3 As String
　　Dim n As Long
　　
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　Set r = Selection
　　If r.Columns.Count > 1 Then Exit Sub
　　If WorksheetFunction.CountA(r) = 0 Then Exit Sub
　　
　　ReDim v(1 To r.Count, 1 To 1)
　　
　　For Each c In r
　　　　For Each e In Split(c.Value, "　")
　　　　　　s2 = "　" & e & "　"
　　　　　　If InStr(s1, s2) = 0 Then
　　　　　　　　s1 = s1 & s2
　　　　　　　　s3 = s3 & "　" & e
　　　　　　End If
　　　　Next
　　　　If Len(s3) > 0 Then
　　　　　　n = n + 1
　　　　　　v(n, 1) = Mid(s3, 2)
　　　　　　s3 = ""
　　　　End If
　　Next

　　r.Value = v
　　
End Sub

・ツリー全体表示


	【82353】Re:セル内重複文字削除

マクロ勉強中です。。 - 24/8/20(火) 12:55 -


	引用なし

	パスワード

▼マナさん：

最近MacBookにPCを変えたのですが、
WindowsのPCで試してみたところ、エラー表示なく動作はしたのですが、
重複している文字が消えずに、選択したセルの右横のセルに入力されている文字が消えてしまいました。

・ツリー全体表示


	【82352】Re:セル内重複文字削除

マナ - 24/8/19(月) 22:05 -


	引用なし

	パスワード

▼マクロ勉強中です。。さん：

>こちらはエラーにはなりませんでした。

であれば、test2をステップ実行（F8)で、
どの行でエラーが発生するのか確認してください。

・ツリー全体表示


	【82351】Re:セル内重複文字削除

マクロ勉強中です。。 - 24/8/19(月) 18:47 -


	引用なし

	パスワード

▼マナさん：
こちらはエラーにはなりませんでした。

・ツリー全体表示


	【82350】Re:セル内重複文字削除

マナ - 24/8/19(月) 7:19 -


	引用なし

	パスワード

▼マクロ勉強中です。。さん：

これはエラーになりますか。

Sub test3()
　　Dim d As Object
　　Set d = CreateObject("scripting.dictionary")
End Sub

　Sub test4()
　　MsgBox "test"
End Sub

・ツリー全体表示


	【82349】Re:セル内重複文字削除

マクロ勉強中です。。 - 24/8/19(月) 6:54 -


	引用なし

	パスワード

▼マナさん：
>どの行でエラーになるのでしょうか？

確認の仕方が間違っているのかもしれませんが、
どの行の赤字になっているわけでもなく、エラー箇所がわかりません。

・ツリー全体表示


	【82348】Re:セル内重複文字削除

マナ - 24/8/18(日) 23:34 -


	引用なし

	パスワード

▼マクロ勉強中です。。さん：
>
どの行でエラーになるのでしょうか？

・ツリー全体表示


	【82347】Re:セル内重複文字削除

マクロ勉強中です。。 - 24/8/18(日) 23:21 -


	引用なし

	パスワード

▼マナさん：
素人過ぎて原因がわからず申し訳ないのですが、

このコンポーネントのライセンス情報が見つかりません。
デザイン環境でこの機能を使うために必要なライセンスがありません。

と出てしまいます。。。

・ツリー全体表示


	【82346】Re:セル内重複文字削除

マナ - 24/8/18(日) 23:08 -


	引用なし

	パスワード

▼マクロ勉強中です。。さん：

Sub test2()
　　Dim d As Object, d2 As Object, d3 As Object
　　Dim r As Range, c As Range
　　Dim e
　　
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　Set r = Selection
　　If r.Columns.Count > 1 Then Exit Sub
　　If WorksheetFunction.CountA(r) = 0 Then Exit Sub
　　r.Columns(2).ClearContents
　　
　　Set d = CreateObject("scripting.dictionary")
　　Set d2 = CreateObject("scripting.dictionary")
　　Set d3 = CreateObject("scripting.dictionary")
　　
　　For Each c In r
　　　　For Each e In Split(c.Value, "　")
　　　　　　If Not d.exists(e) Then
　　　　　　　　d(e) = True
　　　　　　　　d2(e) = True
　　　　　　End If
　　　　Next
　　　　If d2.Count > 0 Then
　　　　　　d3(d3.Count) = Join(d2.keys, "　")
　　　　　　d2.RemoveAll
　　　　End If
　　Next
　　
　　r(1, 2).Resize(d3.Count).Value = WorksheetFunction.Transpose(d3.items)
　　
End Sub

・ツリー全体表示


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

3 / 3837 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free