Excel VBA質問箱 IV

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

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


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

259 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77257】Re:パスワードでロック

マナ - 15/6/26(金) 19:53 -


	引用なし

	パスワード

▼翔子さん：

本題のシート保護の件については、
βさんも仰っていますが、ちゃんと再保護されると思います。

ところで、

＞Contents:=False

なので、保護されていても、
セルの書き込みはできて当然なのですが
そこは誤解ありませんよね？

ご提示の詳細から注文書へ転記するマクロについては、
シート保護を解除しなくても実行可能なのになぜ？
という疑問もありましたので、念のため確認です。

・ツリー全体表示


	【77256】Re:配列　列を並び替える

β - 15/6/26(金) 17:06 -


	引用なし

	パスワード

▼［名前なし］さん：

後者、行指定で配列を取り出すのは、シート関数のINDEXを使えば割合と楽です。
取り出した結果を A40から下に転記しています。

Sub Test1()
　　Dim v As Variant
　　Dim w As Variant
　　
　　v = Range("A1:Z10").Value
　　v = WorksheetFunction.Transpose(v)
　　w = Application.Index(v, Evaluate("row(1:" & UBound(v, 1) & ")"), Array(1, 3, 10))
　　w = WorksheetFunction.Transpose(w)
　　
　　Range("A40").Resize(UBound(w, 1), UBound(w, 2)).Value = w
　　
End Sub

列指定の取り出し、以下のような方法も。

まず、

Function makeArray(r As Range, ParamArray cols())
　　Dim w As Variant
　　Dim col As Variant
　　Dim x As Long
　　Dim c As Range
　　Dim i As Long
　　
　　ReDim w(1 To r.Rows.Count, 1 To UBound(cols) + 1)
　　
　　For Each col In cols
　　　　i = 0
　　　　x = x + 1
　　　　For Each c In Cells(r.Row, col).Resize(r.Rows.Count)
　　　　　　i = i + 1
　　　　　　w(i, x) = c.Value
　　　　Next
　　Next
　　
　　makeArray = w
　　
End Function

こんなコードを準備しておいて、使う場合は

Sub Test2()
　　Dim v As Variant
　　
　　v = makeArray(Range("A1:Z10"), "B", "D", "A", "N", "Z", "F")
　　
　　Range("A20").Resize(UBound(v, 1), UBound(v, 2)).Value = v
　　
End Sub

取り出したい列記号を、その順番で、いくつでも記述。
結果を A20以降に転記しています。

・ツリー全体表示


	【77255】Re:配列　列を並び替える

ウッシ - 15/6/26(金) 15:46 -


	引用なし

	パスワード

配列に取込むなら、

Sub test1()
　　Dim a As Variant
　　Dim i As Long
　　Dim j As Long
　　　　
　　a = Array("B1:B10", "D1:D10", "A1:A10", "N1:N10", "Z1:Z10", "F1:F10")
　　
　　ReDim v(0 To 9, 0 To 5)
　　
　　With Worksheets("Sheet1")
　　　　For i = 0 To 5
　　　　　　For j = 0 To 9
　　　　　　　　v(j, i) = .Range(a(i)).Cells(j + 1, 1)
　　　　　　Next
　　　　Next
　　　　　　　　
　　　　.Range("A15").Resize(10, 6).Value = v
　　
　　End With
　　　　
End Sub

こんな感じで。

・ツリー全体表示


	【77254】Re:配列　列を並び替える

ウッシ - 15/6/26(金) 15:35 -


	引用なし

	パスワード

こんにちは

項目行が有ればフィルタオプションで必要キーの必要列だけ抽出すれば
速いと思います。

・ツリー全体表示


	【77253】Re:配列　列を並び替える

［名前なし］ - 15/6/26(金) 15:32 -


	引用なし

	パスワード

▼β さん：
>
>１．配列に指定セル領域の値をまず取り込んで、その中から抽出。
>２．セル領域から配列に取り込む際に、必要列をその順序も含めて指定。

1しか頭に無かったですが、2が出来るならすごいです。
2を希望します。

やりたい事が、ブックAのデータ範囲から必要列と順序を指定して取り出し、
違うブックのシート(A)にはKEYコードAを含む行だけ転記、
シート(B)にはKEYコードBを含む行だけを転記、
としていくだけです。

また、別で質問しようと思っていますが、
この行を取り出す方法も悩んでおります。

配列(0) = KEYコードAの1行目
配列(1) = KEYコードAの3行目
配列(2) = KEYコードAの10行目
・
・
・
入れ終わった後に、Range("A1:Z" & ubound(配列)) = 配列
と一気に転記したいのです。
ちなみにループで次は、KEYコードBを、KEYコードCをという具合に、
転記していきたいです。

配列(0) = KEYコードAの１行目
転記
配列(1) = KEYコードAの3行目
転記
・
・
だと、処理が遅いと思うので。

・ツリー全体表示


	【77252】Re:配列　列を並び替える

β - 15/6/26(金) 15:08 -


	引用なし

	パスワード

▼Mari さん：

処理方法としては、いろんな方法があるかと思いますが、大きくは２つ
のやりかたになります。Mariさんはいずれをご希望ですか。

１．配列に指定セル領域の値をまず取り込んで、その中から抽出。
２．セル領域から配列に取り込む際に、必要列をその順序も含めて指定。

・ツリー全体表示


	【77251】配列　列を並び替える

Mari - 15/6/26(金) 14:06 -


	引用なし

	パスワード

お世話になっております。

教えてください。
A1:Z10の範囲を配列にします。
配列にした範囲の欲しい列だけを並べ替えて、
抽出することはできるのでしょうか。

たとえば、
B列、D列、A列、N列、Z列、F列の順で配列を作りなおす。
他の列は必要ないです。

宜しくお願いします。

・ツリー全体表示


	【77250】Re:パスワードでロック

翔子 - 15/6/26(金) 11:12 -


	引用なし

	パスワード

マナ様

If ListNo = 0 Then
テキストBOXが入ってない時、texttNo = 0 Then
リストBOXが選択がない時、ListIndex＝-1 then
でした。
ご指摘ありがとうございます。

・ツリー全体表示


	【77249】Re:パスワードでロック

マナ - 15/6/25(木) 22:11 -


	引用なし

	パスワード

▼翔子さん：

私が気になったのは、そこではありません。

＞MsgBox "いずれかの行を選択して、数量を入力してください"

が実行されるような操作をしてみてください。
たぶんMsgboxが表示されないと思います。

ListBoxで選択されたかどうかの判定はこんな感じです。
If ListBox1.ListIndex＝-1 then

ListIndexについて、ヘルプやネット検索で調べてみてください。

・ツリー全体表示


	【77248】Re:パスワードでロック

β - 15/6/25(木) 21:07 -


	引用なし

	パスワード

▼翔子さん：

マナさんご指摘の件は、よ～く、考えてみて下さいね。
それはさておき、アップされたとおりのコードでユーザーフォームでボタンクリック。
処理後は、ちゃんと注文書シートがパスワード付で再保護されていましたよ。

ところで、

保護解除
マクロでセルに書き込み
再保護

って面倒じゃないですか？

ThisWorkbookモジュールに

Private Sub Workbook_Open()
　　'注文書シートロック UserInterfeceOnly付
　　Sheets("注文書").Protect Password:="111", DrawingObjects:=True, _
　　　　　　Contents:=False, Scenarios:=True, UserInterfaceOnly:=True
End Sub

こう書いておくと、操作者からはプロテクト、マクロは自由自在で
いちいち、解除/再保護する必要がなくなりますよ。

・ツリー全体表示


	【77247】Re:パスワードでロック

翔子 - 15/6/25(木) 21:01 -


	引用なし

	パスワード

マナ様

>回答ではありませんが
>以下は、期待通りの動作していますか？
>>　　　　ListNo = ListBox1.ListIndex + 2
>>　　　 If ListNo = 0 Then
自分がのやりたい事が参考に
かいてましたから打ったのです。
Sheet詳細のセル内の値を
リストボックスに反映すると言う
意味ですよね？

・ツリー全体表示


	【77246】Re:パスワードでロック

マナ - 15/6/25(木) 20:26 -


	引用なし

	パスワード

▼翔子さん：

回答ではありませんが
以下は、期待通りの動作していますか？

>　　　　ListNo = ListBox1.ListIndex + 2
>　　　 If ListNo = 0 Then

・ツリー全体表示


	【77245】パスワードでロック

翔子 - 15/6/25(木) 17:23 -


	引用なし

	パスワード

　宜しくおねがいします

パスワードでロックされているセルに、
コマンドボタン、普通のボタンでの処理は下記の書き方でいいんですよね？

Sub 保護パス()
　　With Sheets("Sheet1")
　　　　.Unprotect Password:="1111"
　　　　' 処理
　　　　.Protect Password:="1111", DrawingObjects:=True, _
　　　　　　Contents:=False, Scenarios:=True
　　End With
End Sub

例えば

Private Sub CommandButton1_Click()
　　
With Sheets("注文書") '注文書シートロック解除
　　　　.Unprotect Password:="111" '注文書シートロック解除パス
　　
　　Dim lRow As Long, i As Long
　　Dim ListNo As Long
　　Dim TextNo As Long
　　　　ListNo = ListBox1.ListIndex + 2
　　　 If ListNo = 0 Then
　　　　　　MsgBox "いずれかの行を選択して、数量を入力してください"
　　　　　　Exit Sub
　　　　End If
　　　　Worksheets("注文書").Range("E2").Value = Worksheets("詳細").Cells(ListNo, 5)
　　　　Worksheets("注文書").Range("E3").Value = Worksheets("詳細").Cells(ListNo, 6)
　　Unload Me
　　
.Protect Password:="111", DrawingObjects:=True, _
　　　　　　Contents:=False, Scenarios:=True '注文書シートロック
　　End With
End Sub
ですが、処理が終わった後、パスワードがあかからないのです。
なんででしょうか
宜しくおねがいします

・ツリー全体表示


	【77244】Re:ルーブ

翔子 - 15/6/25(木) 15:35 -


	引用なし

	パスワード

▼kanabun様

誠に申し訳ありません。

Sheet注文書（E３：G３)
セルぬ結合をなくしたらうごきました

・ツリー全体表示


	【77243】Re:ルーブ

翔子 - 15/6/25(木) 15:22 -


	引用なし

	パスワード

kanabunsama

両方うごきませんでした。

Sheet(詳細)E列”コード”、F列”品名”です。

・ツリー全体表示


	【77242】Re:ルーブ

kanabun - 15/6/25(木) 15:06 -


	引用なし

	パスワード

▼翔子さん： > >77240のモジュールは動きませんでした。 > >１、Sheet注文書（E2）コードを入力enterで >２、Sheet詳細（F列コード）,（E列品名）から >　　Sheet注文書（E３）に品名を持ってくる >Sheet注文書での処理 >３、D6に値が入ったら、C6にE3の品名が入るように。 >４、D7に値が入ったら、C7にE3の品名が入るように。 >５、D8に値が入ったら、C8にE3の品名が入るように。 >６、D9に値が入ったら、C9にE3の品名が入るように。 >７、D10に値が入ったら、C10にE3の品名が入るように。＞動きませんでしたというのは、注文書[E2]にコードを入力しても、[E3]に検索された品名が表示されなかったのですか？それとも [D6:D10]のどれかのセルを変更したら、横のE列のセルに[E3]の値が転記されなかったのですか？それとも、両方できなかったのですか？それと、 >２、Sheet詳細（F列コード）,（E列品名）からとここでは書いておられるけど、一番最初の説明では＞ Sheet(詳細)E列”コード”、F列”品名” じゃなかったですか？

・ツリー全体表示


	【77241】Re:ルーブ

翔子 - 15/6/25(木) 14:38 -


	引用なし

	パスワード

kanabun様

77240のモジュールは動きませんでした。

１、Sheet注文書（E2）コードを入力enterで
２、Sheet詳細（F列コード）,（E列品名）から
　　Sheet注文書（E３）に品名を持ってくる
Sheet注文書での処理
３、D6に値が入ったら、C6にE3の品名が入るように。
４、D7に値が入ったら、C7にE3の品名が入るように。
５、D8に値が入ったら、C8にE3の品名が入るように。
６、D9に値が入ったら、C9にE3の品名が入るように。
７、D10に値が入ったら、C10にE3の品名が入るように。
よろしくお願いします。

・ツリー全体表示


	【77240】Re:ルーブ

kanabun - 15/6/25(木) 13:01 -


	引用なし

	パスワード

ちょっと出かけますので、とりあえずあてずっぽで m(_ _)m '入力のあったセルが [E2]のときは (1) を実行し、 '[D6:D10]のときは (2)を実行するように If～ Else～ End If構文で分岐処理して 'ください Private Sub Worksheet_Change(ByVal Target As Range) Dim Rg As Range Dim c As Range '(1) ----------------------------------------------------------- If Target.Address(0, 0) = "E2" Then 　　Dim m As Variant 　　With Worksheets("詳細")　'別シートのコード照合セル範囲　　　　Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp)) 　　End With 　　Application.EnableEvents = False 　　If IsEmpty(Target) Then 　　　　Target.Offset(1).ClearContents 　　Else 　　　　m = Application.Match(Target, Rg, 0) 'Match関数で検索　　　　If IsNumeric(m) Then 　　　　　　Target.Offset(1).Value = Rg.Item(m, 2).Value 　　　　Else 　　　　　　Target.Offset(1).ClearContents 　　　　　　MsgBox "入力されたコードはありません" 　　　　End If 　　End If 　　Application.EnableEvents = True 　　 '(2) ----------------------------------------------------------- Else 　　Set Rg = Intersect(Target, Range("D6:D10")) 　　If Rg Is Nothing Then Exit Sub 　　　Application.EnableEvents = False 　　For Each c In Rg 　　　　If Not IsEmpty(c.Value) Then 　　　　　　c.Offset(, -1).Value = Range("E3").Value 　　　　End If 　　Next 　　Application.EnableEvents = True 　　 End If End Sub

・ツリー全体表示


	【77239】Re:ルーブ

kanabun - 15/6/25(木) 12:46 -


	引用なし

	パスワード

▼翔子さん： > >「名前が適切ではないとでました」 > > 【77221】Re:関数ではなくてマクロでやりたいのです。 >の、Private Sub Worksheet_Change(ByVal Target As Range) >と同じ所にあるからですか？そうです。同じ名前のプロシージャは複数作れません。すでに書いてあるコードをここに再度アップしてください。

・ツリー全体表示


	【77238】Re:ルーブ

kanabun - 15/6/25(木) 12:43 -


	引用なし

	パスワード

[E2]セルにコードを入力するのでなく、すでに入っていたコードを消去してからあたらしいコードを入力する人もいるかもしれないので、 [E2]セルがクリアされたときのことも考慮して、こうしておいた方が親切かも？ Private Sub Worksheet_Change(ByVal Target As Range) 　　If Target.Address(0, 0) <> "E2" Then Exit Sub 　　　　Dim Rg As Range 　　Dim m As Variant 　　With Worksheets("詳細")　'別シートのコード照合セル範囲　　　　Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp)) 　　End With 　　Application.EnableEvents = False 　　If IsEmpty(Target) Then 　　　　Target.Offset(1).ClearContents 　　Else 　　　　m = Application.Match(Target, Rg, 0) 'Match関数で「詳細」シート検索　　　　If IsNumeric(m) Then 　　　　　　Target.Offset(1).Value = Rg.Item(m, 2).Value 　　　　Else 　　　　　　Target.Offset(1).ClearContents 　　　　　　MsgBox "入力されたコードはありません" 　　　　End If 　　End If 　　Application.EnableEvents = True 　　 End Sub

・ツリー全体表示


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

259 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free