Excel VBA質問箱 IV

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

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


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

320 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【76025】Re:非表示について

γ - 14/8/23(土) 21:04 -


	引用なし

	パスワード

マクロ記録をとると
ActiveWindow.Visible = False
といったコードが得られます。

その他、ウインドを最小化しておくという方法もあるでしょう。
その場合は、これもマクロ記録で、
ActiveWindow.WindowState = xlMinimized
とわかります。

ユーザーフォームから、他のブックを開くのはどうするんでしょう。
そのためのボタンを作っておくということですか？

・ツリー全体表示


	【76024】Re:非表示について

γ - 14/8/23(土) 12:08 -


	引用なし

	パスワード

>そのブックだけを非表示にするには、どのようなプログラムにすれば良いのでしょうか？
バージョンはいくつですか？
2010なら、表示タブのウインドウの「表示しない」をクリックする操作を
マクロ記録してみると、コードは得られると思いますよ。
他のバージョンでも同じような機能があるはずです。

・ツリー全体表示


	【76023】非表示について

平社員 - 14/8/23(土) 11:09 -


	引用なし

	パスワード

VBAにて、あるブックを起動時にフォームのみ表示して、
いるのですが、そのブックを開いているときは、他のエクセルの
が開けません。

そのブックだけを非表示にするには、どのようなプログラムにすれば良いのでしょうか？

Private Sub Workbook_open()

application.Visible=True

UserForm.Show

End Sub

・ツリー全体表示


	【76022】Re:期間の計算

sim - 14/8/21(木) 11:21 -


	引用なし

	パスワード

▼γ さん：
>こちらは、VBAの質問箱ですので、別のところに質問されたほうが
>よろしいと思います。
>
>なお、質問にあたっては、
>個々の現象から入るのではなく、
>・実行したいことをまず明確にして、
>・そのために自分はこんなことをした、
>・しかしこんなことになってしまう、
>という順序で書いたほうがよろしいでしょう。
>老婆心ながら。

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

・ツリー全体表示


	【76021】Re:期間の計算

γ - 14/8/21(木) 11:09 -


	引用なし

	パスワード

こちらは、VBAの質問箱ですので、別のところに質問されたほうが
よろしいと思います。

なお、質問にあたっては、
個々の現象から入るのではなく、
・実行したいことをまず明確にして、
・そのために自分はこんなことをした、
・しかしこんなことになってしまう、
という順序で書いたほうがよろしいでしょう。
老婆心ながら。

・ツリー全体表示


	【76020】期間の計算

sim - 14/8/21(木) 9:39 -


	引用なし

	パスワード

お世話になります。
期間の計算についてお尋ねします。
民法にある
「初日不算入の原則」
期間の満了日は、期間が終了する週、月、または年の起算日に応当する日の前日となります
なのですが、
期間の開始日「2014/01/29」…A1　
期間の終了日「2014/5/30」…A2
の場合に下記のような式を書きました。

=DATEDIF(A1,A2,"M")&"."&ABS(DATEDIF(A1,A2,"MD")-1)

これで返る数値が"4.0"となります。
これを"4.1"とするためにはどのような方法がありますか？
どなたかご教授お願いします。
尚、求められた数値を切り上げして"5"とするためにわざわざ小数点にしています。
よろしくお願いします。

・ツリー全体表示


	【76019】Re:パスワード生成時に数字１つ(0から9の...

独覚 - 14/8/21(木) 6:53 -


	引用なし

	パスワード

ht tp://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14130509349
これもそうかな？

・ツリー全体表示


	【76018】Re:パスワード生成時に数字１つ(0から9の...

γ - 14/8/20(水) 21:33 -


	引用なし

	パスワード

まあ、今度は、自分が納得いくまで、とことん質問することですよ。
わかった積もりで先に進まないほうがいい。

・ツリー全体表示


	【76017】Re:パスワード生成時に数字１つ(0から9の...

kanabun - 14/8/20(水) 21:32 -


	引用なし

	パスワード

ht tp://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=163646&rev=0 なるほど。これはちょっとひどい。

・ツリー全体表示


	【76016】Re:パスワード生成時に数字１つ(0から9の...

γ - 14/8/20(水) 20:51 -


	引用なし

	パスワード

回答者への参考として。
ht tp://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=163646&rev=0
ht tp://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=163842&rev=0

ちょっとひど過ぎない？

・ツリー全体表示


	【76015】Re:パスワード生成時に数字１つ(0から9の...

kanabun - 14/8/20(水) 20:39 -


	引用なし

	パスワード

▼初心者さん： >生成されるパスワードに数字を含めたいのですが、 >どのようにすれば良いでしょうか？これは >' 文字種類 >kind = MenuSheet.Range("KIND").Value >Select Case kind > >Case "英字": chars = "abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" >Case "数字": chars = "0123456789" >Case "記号": chars = "!#$%&@?\+-_" >Case Else: chars = "abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!#$%&@?\+-_" > >End Select 文字種類が「英字」とか「記号」だったら、何回作っても数字は混じってこないから、文字種類が >Case Else のばあいを言ってるんですよね？そのばあいだったら、数字が入るまでパスワード生成を繰り返せばいいのでは？　　For j = 1 To num 　　　　password = Space$(cols) 'パスワードの桁数分のスペース　　　　Randomize 　　　　　　　　k = 0 　　　　Do 　　　　　　For i = 1 To cols 　　　　　　　　pointer = Int(Rnd * upper) + 1 　　　　　　　　Mid(password, i, 1) = Mid(chars, pointer, 1) 　　　　　　Next 　　　　　　k = k + 1 　　　　Loop Until password Like "*#*" 　　　　　　　　With PasswordSheet.Cells(j + 1, 1) 　　　　　　.Range("A1").Value = j 　　　　　　.Range("B1").Value = password 　　　　　　.Range("C1").Value = k　 '参考のため繰り返した回数　　　　End With 　　　　　　　　Next

・ツリー全体表示


	【76014】パスワード生成時に数字１つ(0から9のい...

初心者 - 14/8/20(水) 20:03 -


	引用なし

	パスワード

パスワード生成時に必ず数字を含めてパスワードを生成したい

下記マクロで実行しておりますが、生成されるパスワードに数字が含まれない場合があります 
生成されるパスワードに数字を含めたいのですが、
どのようにすれば良いでしょうか？
ご教授下さい

EXCEL2010を利用しております

Sub Macro1()
Const DEFAULT_COLS = 8 ' パスワードの桁数
Const DEFAULT_NUM = 1 ' パスワードの個数
Dim cols As Integer
Dim num As Integer
Dim chars As String, password As String
Dim upper As Integer, pointer As Integer, i As Integer

Set MenuSheet = Worksheets("MENU")
Set PasswordSheet = Worksheets("password")

' パスワードの桁
cols = MenuSheet.Range("COLS").Value
If cols < 1 Then
cols = DEFAULT_COLS
End If

' パスワードの個数
num = MenuSheet.Range("NUM").Value
If num < 1 Then
num = DEFAULT_NUM
End If

' 文字種類
kind = MenuSheet.Range("KIND").Value
Select Case kind

Case "英字": chars = "abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Case "数字": chars = "0123456789"
Case "記号": chars = "!#$%&@?\+-_"
Case Else: chars = "abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!#$%&@?\+-_"

End Select
upper = Len(chars)

PasswordSheet.Activate
PasswordSheet.Range("A:B").ClearContents ' 前回の結果を消去
PasswordSheet.Range("A1").Value = "No."
PasswordSheet.Range("B1").Value = "パスワード"

For j = 1 To num
password = ""
Randomize
For i = 1 To cols
pointer = Int(Rnd * upper) + 1
password = password + Mid(chars, pointer, 1)
Next

PasswordSheet.Cells(j + 1, 1).Value = j
PasswordSheet.Cells(j + 1, 2).Value = password

Next

End Sub

最後まで見てくださりありがとうございました
宜しくお願い申し上げます

・ツリー全体表示


	【76013】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 21:59 -


	引用なし

	パスワード

▼kanabun さん：
>▼MARUMO さん：
>
>>>1. SheetA の複製を作り（SheetA'とする）
>>>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
>>>　　SheetA'の最終行+1行にコピーして追加。
>>>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。
>
>参考まで（というか、自分のメモ）です。
>
>Sub Try3()
>　　Dim newBook As Workbook
>　　Dim A As Worksheet
>　　Dim B As Worksheet
>　　Dim r As Range, q As Range, c As Range
>　　
>　　Set B = Worksheets("db")
>　　Worksheets("wk").Copy　　　 '複製を作成(newBook)
>　　Set newBook = ActiveWorkbook
>　　Set A = newBook.Worksheets(1)
>　　With A
>　　　　Set q = .Cells(.Rows.Count, "D").End(xlUp) '最終セル
>　　　　Set r = .Range("D2", q)
>　　　　Set q = q.EntireRow.Range("A1")
>　　End With
>　　'[B]の型番が[A]になければ [A]の最終行＋1に追加Copyする
>　　For Each c In B.Range("D2", B.Cells(Rows.Count, "D").End(xlUp))
>　　　　If WorksheetFunction.CountIf(r, c) = 0 Then
>　　　　　　Set q = q.Offset(1)
>　　　　　　c.EntireRow.Copy q
>　　　　End If
>　　Next
>　　'このあと newBookに名前をつけて保存
>　　
>End Sub
ありがとうございます。
今後の為に、参考させていただきます。
大変お世話になりました。

・ツリー全体表示


	【76012】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 18:59 -


	引用なし

	パスワード

▼MARUMO さん： >>1. SheetA の複製を作り（SheetA'とする） >>2. SheetBの型番を上から順に見ていって SheetA'になかったら、 >>　　SheetA'の最終行+1行にコピーして追加。 >>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。参考まで（というか、自分のメモ）です。 Sub Try3() 　　Dim newBook As Workbook 　　Dim A As Worksheet 　　Dim B As Worksheet 　　Dim r As Range, q As Range, c As Range 　　　　Set B = Worksheets("db") 　　Worksheets("wk").Copy　　　 '複製を作成(newBook) 　　Set newBook = ActiveWorkbook 　　Set A = newBook.Worksheets(1) 　　With A 　　　　Set q = .Cells(.Rows.Count, "D").End(xlUp) '最終セル　　　　Set r = .Range("D2", q) 　　　　Set q = q.EntireRow.Range("A1") 　　End With 　　'[B]の型番が[A]になければ [A]の最終行＋1に追加Copyする　　For Each c In B.Range("D2", B.Cells(Rows.Count, "D").End(xlUp)) 　　　　If WorksheetFunction.CountIf(r, c) = 0 Then 　　　　　　Set q = q.Offset(1) 　　　　　　c.EntireRow.Copy q 　　　　End If 　　Next 　　'このあと newBookに名前をつけて保存　　 End Sub

・ツリー全体表示


	【76011】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 16:09 -


	引用なし

	パスワード

▼kanabun さん：
>▼MARUMO さん：
>
>>SheetAの方は、型番が複数存在するイメージで
>>書いてしまってました。
>>今の所、同じ型番が複数行になる見込みだそうです。
>>（すみません。先程わかりました）
>
>> 1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
>> 2.SheetAの2行目から最終行までをSheetBの最終行+1
>> に貼り付け。
>
>この処理は
>
>1. SheetA の複製を作り（SheetA'とする）
>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
>　　SheetA'の最終行+1行にコピーして追加。
>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。
>
>と同じことだと思うけど？
>そうなら、後者の方法のほうが作業量が少ない（行削除しない）ので
>効率的ですよね？

15:11の補足です。
非常に助かりました。
ありがとうございました。

・ツリー全体表示


	【76010】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 15:11 -


	引用なし

	パスワード

▼kanabun さん：
>▼MARUMO さん：
>
>>SheetAの方は、型番が複数存在するイメージで
>>書いてしまってました。
>>今の所、同じ型番が複数行になる見込みだそうです。
>>（すみません。先程わかりました）
>
>> 1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
>> 2.SheetAの2行目から最終行までをSheetBの最終行+1
>> に貼り付け。
>
>この処理は
>
>1. SheetA の複製を作り（SheetA'とする）
>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
>　　SheetA'の最終行+1行にコピーして追加。
>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。
>
>と同じことだと思うけど？
>そうなら、後者の方法のほうが作業量が少ない（行削除しない）ので
>効率的ですよね？

沢山のアドバイスありがとうございます。
データの持ち方、正しい処理を行ううえでは
おっしゃる通りなのですが、
今回のデータについては、少し特殊と言いますか・・・
ファイルを使っている方に確認をしたところ、
データは置き換えでいいとの事でしたので
あれから、なんとか下記までたどり着けました。

（↓シート名等は変更しております。）

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim r As Long

Set ws1 = Sheets("db")'SheetB
Set ws2 = Sheets("wk")'SheetA

’同じ型番があれば削除
lastRow = ws1.Range("D" & Rows.Count).End(xlUp).Row
For r = lastRow To 2 Step -1
If WorksheetFunction.CountIf(ws2.Columns("D"), ws1.Range("D" & r)) > 0 Then
ws1.Rows(r).Delete
End If
Next

’SheetB(wk)へ追加処理
maxrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
maxrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

ws2.Select
Range(Cells(2, 1), Cells(maxrow2, 126)).Copy
ws1.Select
Range("A" & maxrow1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

・ツリー全体表示


	【76009】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 14:44 -


	引用なし

	パスワード

▼MARUMO さん： >SheetAの方は、型番が複数存在するイメージで >書いてしまってました。 >今の所、同じ型番が複数行になる見込みだそうです。 >（すみません。先程わかりました） > 1.SheetBに同じ型番がみつかれば、SheetBからすべて削除 > 2.SheetAの2行目から最終行までをSheetBの最終行+1 > に貼り付け。この処理は 1. SheetA の複製を作り（SheetA'とする） 2. SheetBの型番を上から順に見ていって SheetA'になかったら、　　SheetA'の最終行+1行にコピーして追加。 3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。と同じことだと思うけど？そうなら、後者の方法のほうが作業量が少ない（行削除しない）ので効率的ですよね？

・ツリー全体表示


	【76008】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 12:20 -


	引用なし

	パスワード

▼MARUMO さん： >同じ型番が2件(行)以上存在する事もありますので >SheetAに2行あれば、SheetBが1行だったとしても >SheetAに2行と置き換えしたいです。 > それは、むつかしいですよ「型番」だけで判断すれば、同じ型番があったら、データ作成時期はちがうかもしれないけれど、同じデータのはずです。そもそも[SheetA]になぜ複数の同じ型番が存在するのですか？さっき言ったように、同じ型番でも出所がちがうとか、区別される項目があるのなら、「型番」だけでなく、他と区別できる（その識別できる）項目を加えて、行を特定しなければならないはずですけど？もしSheetA に4つの同じ型番データがあったとして、SheetB にある同じ型番データは SheetAの「どの」データと置き換えるのですか？あるいは、SheetB に現在ある同じ型番データは SheetA の4つのデータとみな違う種類のものだとしたら、SheetBのデータを削除することなく、あらたに SheetAの4つのデータを追加しなければいけないはずです。 SheetA にあるだけ全部 SheetB に「追加」したとして、次回のときは SheetB に同じ型番が複数存在することになりますけど、どうやって対応をつけるんでしょう？

・ツリー全体表示


	【76007】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 11:56 -


	引用なし

	パスワード

▼kanabun さん：
>▼MARUMO さん：
>
>前のと同じですが、追加先セル変数を1つ増やして、記述を簡単に
>しました。
>
>Sub Test更新2()
>　　Dim A As Worksheet, B As Worksheet
>　　Dim c As Range, r As Range, q As Range
>　　Dim m
>　　
>　　Set A = Worksheets("SheetA")
>　　Set B = Worksheets("SheetB")
>　　Set q = B.Cells(B.Rows.Count, 1).End(xlUp) '[B]A列最終セル
>　　Set r = B.Range("A2", q)
>　　For Each c In A.Range("A2", _
>　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp))
>　　　　m = Application.Match(c, r, 0) 'SheetB にあるか？
>　　　　If IsNumeric(m) Then
>　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き)
>　　　　Else
>　　　　　　Set q = q.Offset(1)
>　　　　　　A.Rows(c.Row).Copy q　　　'新規データ追加
>　　　　End If
>　　Next
>End Sub

ありがとうございました。
思っていた通りの事ができました。
検証用に、
SheetAに1つの型番(X型番)で10件のデータを用意しました。
追加されたデータは、10×4(4倍)の40件がSheetBにコピーされています。
何故4倍なのか???
X型番はSheetBに10件(削除できていない)準備していましたので
50件になりました。

同じ型番が2件(行)以上存在する事もありますので
SheetAに2行あれば、SheetBが1行だったとしても
SheetAに2行と置き換えしたいです。

SheetAの方は、型番が複数存在するイメージで
書いてしまってました。
今の所、同じ型番が複数行になる見込みだそうです。
（すみません。先程わかりました）

・ツリー全体表示


	【76006】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 11:55 -


	引用なし

	パスワード

▼MARUMO さん： [SheetA] 　　 A　　B　　　C　　 D　 1　型番　枝番　値1　値2 2　A10　　1　　 100　 200 3　A10　　2　　 100　 300 4　A10　　3　　 200　 500 [SheetB] 更新前　　A　　B　　　C　　 D　 1　型番　枝番　値1　値2 2　 A10　　no　　 0　　 0 --- 上記のように [SheetA]に複数の型番「A10」があるときでも、処理は [SheetA]の上から順番にループ処理していきますから、まず[SheetA]の2行目が [SheetB]の2行目にコピーされ、つぎは、[SheetA]の3行目が [SheetB]の2行目にコピーされ、つぎは、[SheetA]の4行目が [SheetB]の2行目にコピーされるので、結果は [SheetB] 更新後　　A　　B　　　C　　 D　 1　型番　枝番　値1　値2 2　 A10　　3　　 200　 500 となるはずです。（同じ型番があったら、同じ行にコピー上書きされるので、最後のデータだけがのこる） >検証用に、 >SheetAに1つの型番(X型番)で10件のデータを用意しました。 >追加されたデータは、10×4(4倍)の40件がSheetBにコピーされています。 >何故4倍なのか??? どういうことか分かりません。

・ツリー全体表示


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

320 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free