Results of 1 - 1 of about 37684 for IF (0.008 sec.)
- [[20121026092804]]
- #score: 1591
- @digest: d854c8254fa6a3783c599a3e025feeaf
- @id: 60590
- @mdate: 2012-10-26T10:58:41Z
- @size: 14982
- @type: text/plain
- #keywords: myans (56256), checkstr (46416), okflag (43825), ansr (39542), 認" (28837), 除終 (26885), 了確 (18965), 再確 (11767), 録デ (11311), 合マ (9055), 。", (5274), vbokcancel (5143), 削除 (5086), 力") (4769), ピン (4171), myr (3627), ンセ (3625), myrange (3547), 分解 (3166), entirerow (3116), キャ (3032), ャン (2303), xlwhole (2140), 確認 (2093), inputbox (1932), delete (1921), 未入 (1846), nothing (1773), msgbox (1768), boolean (1378), を削 (1361), variant (1333)
- 『指定したbメッセージボックス複数削除したいんですが?』（ピン）
Excel2007 今、下記のようなマクロになっているんですが、b指定する時に、 1だけを削除とか1〜12までを削除するみたいな感じにしたいんですけど、 教えていただきますか? Sub 削除() Dim myNo As String Dim myRange As Range '確認メッセージの表示（キャンセルの場合マクロを抜ける） If MsgBox("データの登録データを削除しますか。", vbOKCancel + 32, "削除確認") = vbCancel Then Exit Sub End If InputData: Sheets("データ").Select Range("A65536").Select '下から空白の行を選択する。 Selection.End(xlUp).Select '1つ行のセルのを選択 ActiveCell.Offset(0, 0).Select myNo = Application.InputBox("削除したいb選択してください!" _ , "nw定", ActiveCell.Value, 1) '<何も入力せずOKの場合、再入力します。> If myNo = "" Then MsgBox "未入力です。", 16, "再確認" GoTo InputData End If '<キャンセルの場合、処理を終わりにします。> If myNo = "False" Then Sheets("入力").Select Exit Sub End If 'bをA行から検索 Set myRange = Range("A2:A60000").Find(myNo) 'bェ見つからない場合 If myRange Is Nothing Then '元のシートに戻る MsgBox "該当するbヘありません。", 16, "再確認" GoTo InputData Else 'シート保護解除 ActiveSheet.Unprotect '検索したb選択して削除 myRange.Cells.Select Selection.EntireRow.Delete Shift:=xlUp '元のシートに戻る Sheets("入力").Select Range("h6").Select MsgBox "" & (myNo) & "の削除が終わりました。", 64, "削除終了確認" End If Call 並び替え実行 End Sub ---- コードとしては シート.Select とか セル.Select 使わないほうがいいとか 65536 という【マジックナンバー】は使わないほうがいいとか 何よりも、ループ制御で、 GoTo ラベル は、コードを書くときは簡単で楽ちんだけど、あとで見たときに わかりにくくなるのと、今後追加改訂をしていくときに、時としてバグの大きな要因になるといった保守性の面で 【絶対に使うべきではない】とか、いろいろあるけど、さておき。 要望は No2,No5-No6,No12,・・・ といった指定をしたいということかな? (ぶらっと) ---- その通りなんですが。 bヘいらないんですけど、1-10,15,18 みたいな感じがいいんですけど・・ (ピン） ---- ということは、指定するものが行番号 ということ? アップされたコードでは、この入力された値、仮に 10 だとすると、この10 で Set myRange = Range("A2:A60000").Find(myNo) と 直接検索しているけど??? このコードの意味は? 行番号なら、今、こちらで書いたコードよりもっとすっきりした簡単なものになるけど、ほんとにそれでいいの? あっと。もしかして、A列には、必ず No10 というように "No"が頭についた数字が入っていて、 指定された数字に No.をつけて検索したいということかな? いずれにしても、実際に A列にはどんな値が入っているのか、で、それを削除するために どのような文字列で指定したいのか、サンプルで説明してくれる? (ぶらっと) ---- すみません。マクロを分かっていなくて、サンプルからコピーして持ってきたんですが。 入力シートからコピーしてデータシートに貼り付けて1から順に貼り付けているので、 a1 a@ a1のセルにbェ入っています。 a2 1 a2のセル以降に1から順番に数字が入る形になっているんですが・・ a3 2 a4 3 ・ ・ ・ ・ 指定しているのは行番号なんですが・・ すみません分かりにくい説明で。 （ピン） ---- ということは、A2から下には、たぶん 1,2,3,4・・・とあるんだろうけど、とにかく数字がある。 (以下のコード処理上は、連番じゃなくても、また数字じゃなくてもいいんだけど） で、たとえば 2-4 と指定すると、行としては (このサンプルでは）3行目から 5行目を削除するということだね。 それなら、以下のコードで試してみて。 入力は、1-10,15,18 といった要領で。 ただし、これは行番号じゃないよ。 A列に1と入っている最初の行からA列に10と入っている最初の行までを削除。 A列に15 と入っている最初の行を削除、A列に18と入っている最初の行を削除。 こんなロジック。 そうじゃなく、A列にどんな値が入っていようと、2行目〜11行目、16行目、19行目を削除するなら 少しシンプルなコードになるんだけど。 Sub Sample() Dim myAns As String Dim okflag As Boolean Dim myR As Range '確認メッセージの表示（キャンセルの場合マクロを抜ける） If MsgBox("データの登録データを削除しますか。", vbOKCancel + 32, "削除確認") = vbCancel Then Exit Sub With Sheets("データ") 'A列最後のデータの値（初期値として） myAns = .Range("A" & .Rows.Count).End(xlUp).Value Do okflag = False myAns = Application.InputBox("削除したいb選択してください!" _ , "nw定", myAns, 1) If myAns = "False" Then Exit Sub 'キャンセルボタン If Len(myAns) = 0 Then MsgBox "未入力です。", 16, "再確認" Else Set myR = CheckStr(.Columns("A"), myAns) If myR Is Nothing Then MsgBox "該当するbヘありません。", 16, "再確認" Else myR.EntireRow.Delete MsgBox myAns & "の削除が終わりました。", 64, "削除終了確認" '元のシートに戻る Application.Goto Sheets("入力").Range("h6") Call 並び替え実行 okflag = True End If End If Loop While Not okflag End With End Sub Private Function CheckStr(a As Range, s As String) As Range Dim v1 As Variant Dim d1 As Variant Dim v2 As Variant Dim d2 As Variant Dim ansR As Range Dim r As Range Dim c1 As Range Dim c2 As Range Dim i1 As Long Dim i2 As Long Dim ok As Boolean ok = True v1 = Split(s, ",") ' "," 区切りで分解 For Each d1 In v1 v2 = Split(d1, "-") ' その中身を "-" 区切りで分解 If UBound(v2) > 1 Then ok = False ' - でくぎられたブロックが3つ以上ならエラー Exit For End If Set c1 = a.Find(What:=v2(0), LookAt:=xlWhole) If c1 Is Nothing Then ok = False Exit For End If If UBound(v2) = 1 Then Set c2 = a.Find(What:=v2(1), LookAt:=xlWhole) If c2 Is Nothing Then ok = False Exit For End If End If i1 = c1.Row i2 = 0 If UBound(v2) = 1 Then i2 = c2.Row If i2 = 0 Then Set r = c1 Else If i1 > i2 Then ok = False Exit For End If Set r = c1.Resize(i2 - i1 + 1) End If If ansR Is Nothing Then Set ansR = r Else Set ansR = Union(ansR, r) End If If Not ok Then Exit For Next If ok Then Set CheckStr = ansR End Function (ぶらっと) ---- すみません。 myR.EntireRow.Deleteの部分でデバックになってしまうんですが? どうしてですか? (ピン） ---- どうしてといわれても・・・ コードとしては、 If myR Is Nothing Then MsgBox "該当するbヘありません。", 16, "再確認" Else myR.EntireRow.Delete myRに有効なアドレスがある場合のみ処理しているので・・・ 実際に表示されたメッセージの内容と、InputBoxで、どんな文字列を入力したか教えてくれる? シートが保護ざれているなんてことはないんだよねぇ・・・ (ぶらっと) ---- 本当にすいませんでした。 シートが保護されたままでした。 丁寧にありがとうございました。 （ピン） ---- また質問なんですが、削除するときに行全体をdeleteではなく、A列からQ列をdeleteしたいのですが・・ たびたびすいません。教えていただきますでしょうか。 (ピン） ---- myR.EntireRow.Delete これを myR.EntireRow.Range("A1:Q1").Delete Shift:=xlUp (ぶらっと) ---- Rの列に=IF(H2="","",COUNTIF(H$2:H2,H2))関数が入っているのですが、 マクロを実行すると、H2の部分が、#REF!になってしまいます。 削除したときにR列の関数の参照元はそのままにしたいのですが・・ 教えていただきますでしょうか? （ピン） ---- 関数で参照しているセルが削除されると、行削除であろうが、セル領域削除であろうが #REF! になってしまうね? ちょっとわからないのは、最初にそちらでアップしたコードって、実際に使っていたものではないの? もし、使っていたとしたらシート保護の件もそうなんだけど、削除したら、その時点で #REF! は発見できていたのでは? それとも、アップしたコードは実際に使ったことがなかったのかな? いずれにしても、以下のようなこと? 先ほど連絡した myR.EntireRow.Range("A1:Q1").Delete Shift:=xlUp この後に .Range("R2:R" & .Range("R" & .Rows.Count).End(xlUp).Row).Formula = "=IF(H2="""","""",COUNTIF(H$2:H2,H2))" (ぶらっと) ---- コードは使用したことがなかったです。すみません。 入力何ですが?1-10 といった要領で入力しているのですが、1つだけしか削除されないようなんですが・・? （ピン） ---- >1-10 といった要領で入力しているのですが、1つだけしか削除されないようなんですが・・? A2から下に1,2,3,4・・・・・・・,99,100 と A101まで連番をふって、今、目の前で 1-10 を入れたけど ちゃんと10行削除されているけどなぁ?? それとも、1つだけというのが 1-10,20,30-35 と複数ブロック指定した1つだけということ? これについても、ちゃんと指定したものがすべて削除されているけどねぇ、こちらでは。 追記）ごめん!ごめん! 古いバージョン（行全体を削除）でテストしていた。 新しいバージョンでは、確かに!! のちほど修正してアップするね。 (ぶらっと) ---- Sample を入れ替え。CheckStr は変更なし。 Sub Sample() Dim myAns As String Dim okflag As Boolean Dim myR As Range Dim myA As Range '確認メッセージの表示（キャンセルの場合マクロを抜ける） If MsgBox("データの登録データを削除しますか。", vbOKCancel + 32, "削除確認") = vbCancel Then Exit Sub With Sheets("データ") 'A列最後のデータの値（初期値として） myAns = .Range("A" & .Rows.Count).End(xlUp).Value Do okflag = False myAns = Application.InputBox("削除したいb選択してください!" _ , "nw定", myAns, 1) If myAns = "False" Then Exit Sub 'キャンセルボタン If Len(myAns) = 0 Then MsgBox "未入力です。", 16, "再確認" Else Set myR = CheckStr(.Columns("A"), myAns) If myR Is Nothing Then MsgBox "該当するbヘありません。", 16, "再確認" Else For Each myA In myR.Areas myA.EntireRow.Columns("A:Q").Delete Shift:=xlUp Next .Range("R2:R" & .Range("A" & .Rows.Count).End(xlUp).Row).Formula = "=IF(H2="""","""",COUNTIF(H$2:H2,H2))" MsgBox myAns & "の削除が終わりました。", 64, "削除終了確認" '元のシートに戻る Application.Goto Sheets("入力").Range("h6") ' Call 並び替え実行 okflag = True End If End If Loop While Not okflag End With End Sub (ぶらっと) ---- 本当に色々ありがとうございました。 （ピン） ---- ↑のコードでも目的は達成できるけど、行全体を削除する最初のコードに、急遽、間に合わせで A-Qのみの削除をいれたもの。 最初からA-Q削除を前提にすれば以下のほうがすっきりする。 フルセット入れ替え。 Sub Sample() Dim myAns As String Dim okflag As Boolean Dim myR As Range '確認メッセージの表示（キャンセルの場合マクロを抜ける） If MsgBox("データの登録データを削除しますか。", vbOKCancel + 32, "削除確認") = vbCancel Then Exit Sub With Sheets("データ") 'A列最後のデータの値（初期値として） myAns = .Range("A" & .Rows.Count).End(xlUp).Value Do okflag = False myAns = Application.InputBox("削除したいb選択してください!" _ , "nw定", myAns, 1) If myAns = "False" Then Exit Sub 'キャンセルボタン If Len(myAns) = 0 Then MsgBox "未入力です。", 16, "再確認" Else Set myR = CheckStr(.Columns("A"), myAns) If myR Is Nothing Then MsgBox "該当するbヘありません。", 16, "再確認" Else myR.Delete Shift:=xlUp .Range("R2:R" & .Range("A" & .Rows.Count).End(xlUp).Row).Formula = "=IF(H2="""","""",COUNTIF(H$2:H2,H2))" MsgBox myAns & "の削除が終わりました。", 64, "削除終了確認" '元のシートに戻る Application.Goto Sheets("入力").Range("h6") ' Call 並び替え実行 okflag = True End If End If Loop While Not okflag End With End Sub Private Function CheckStr(a As Range, s As String) As Range Dim v1 As Variant Dim d1 As Variant Dim v2 As Variant Dim d2 As Variant Dim ansR As Range Dim r As Range Dim c1 As Range Dim c2 As Range Dim i1 As Long Dim i2 As Long Dim ok As Boolean ok = True v1 = Split(s, ",") ' "," 区切りで分解 For Each d1 In v1 v2 = Split(d1, "-") ' その中身を "-" 区切りで分解 If UBound(v2) > 1 Then ok = False ' - でくぎられたブロックが3つ以上ならエラー Exit For End If Set c1 = a.Find(What:=v2(0), LookAt:=xlWhole) If c1 Is Nothing Then ok = False Exit For End If If UBound(v2) = 1 Then Set c2 = a.Find(What:=v2(1), LookAt:=xlWhole) If c2 Is Nothing Then ok = False Exit For End If End If i1 = c1.Row i2 = 0 If UBound(v2) = 1 Then i2 = c2.Row If i2 = 0 Then Set r = c1.Resize(, 17) Else If i1 > i2 Then ok = False Exit For End If Set r = c1.Resize(i2 - i1 + 1, 17) End If If ansR Is Nothing Then Set ansR = r Else Set ansR = Union(ansR, r) End If If Not ok Then Exit For Next If ok Then Set CheckStr = ansR End Function (ぶらっと) ---- 最初から最後まで丁寧に指導して頂きありがとうございました。 （ピン）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201210/20121026092804.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97043 documents and 608214 words.
訪問者：