Excel VBA質問箱 IV

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

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


7436 / 13645 ツリー ←次へ | 前へ→

【39100】フォームへの呼び込み、登録について レオン 06/6/17(土) 21:02 質問[未読]
【39107】Re:フォームへの呼び込み、登録について Kein 06/6/18(日) 1:01 回答[未読]
【39108】Re:フォームへの呼び込み、登録について Kein 06/6/18(日) 1:05 発言[未読]
【39212】Re:フォームへの呼び込み、登録について レオン 06/6/19(月) 21:43 お礼[未読]

【39100】フォームへの呼び込み、登録について
質問  レオン  - 06/6/17(土) 21:02 -

引用なし
パスワード
   すいません、教えてください。

フォームを作成し、各行にデータを入力しています。
いま、フォーム内にテキストボックスが6つあるとして下のように
複数行並んでいるとします。

   A   B   C   D   E   F
1  txt1 txt2 txt3 txt4 txt5 txt6
・・・

この、並んだデータのうち1行訂正を入れたいと思ったときに、量が
膨大なので、探し出すのが困難で、簡単に検索して訂正できないか
と考えております。

フォーム内に「呼込」ボタンを作成しておき、txt3、txt4、txt6の3つを
埋めます。その後、呼込ボタンを押すと、txt3をC列、txt4をD列、
txt6をF列から検索し、その3つが完全に1致した行のデータを他の
txt1やtxt2、txt5に呼び出し、txt2のみを訂正して、「登録」すると元
の位置の行のtxt2のみ変更できる。といったコードを作成するのは難
しいでしょうか?

検索方法はなんとなく分かってきたのですが、複数の検索、また再度
同じ位置への登録方法がわからなく困っています。

長々と分かりづらい質問で申し訳ありませんが、よろしくお願いします。

【39107】Re:フォームへの呼び込み、登録について
回答  Kein  - 06/6/18(日) 1:01 -

引用なし
パスワード
   フォームというのは、もちろんユーザーフォームのことですよね ?
その図を見ると、何かワークシートに直接テキストボックスを
配置したように見えますけど・・。ま、常識的にユーザーフォームであると解釈して
フォームモジュールの先頭から、以下のコードを入れてみて下さい。
シート名などはそちらで適当に修正すること。あと、
CommandButton1 の Caption が「呼込」で、CommandButton1 の Caption が
「登録」ということにしています。

Private MyR As Range

Private Sub UserForm_Initialize()
  With Worksheets("Sheet1")
   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
  End With
  If WorksheetFunction.CountA(MyR) = 0 Then
   Set MyR = Nothing
  End If
  Me.CommandButton2.Enabled = False
End Sub

Private Sub CommandButton1_Click()
  Dim i As Integer, j As Integer, Ans As Integer
  Dim FomSt As String
  Dim Flg As Boolean

  If MyR Is Nothing Then
   MsgBox "データ領域がありません", 48: Exit Sub
  Else
   CommandButton2.Enabled = True
   CommandButton1.Enabled = False
  End If
  Ans = MsgBox("抽出後の再入力のため検索値を消去しますか", 36)
  j = 65
  For i = 1 To 6
   With UserForm1.Controls("TextBox" & i)
     If .Text <> "" Then
      FomSt = FomSt & Chr(j) & "1=" & _
      """" & .Text & """" & ","
      If Ans = 6 Then .Text = ""
     End If
   End With
   j = j + 1
  Next i
  If FomSt = "" Then Exit Sub
  If InStr(1, FomSt, ",") = Len(FomSt) Then Flg = True
  If Flg Then
   FomSt = "=IF(" & FomSt & "1,"""")"
  Else
   FomSt = Left$(FomSt, Len(FomSt) - 1)
   FomSt = "=IF(AND(" & FomSt & "),1,"""")"
  End If
  MyR.Offset(, 255).Formula = FomSt
End Sub

Private Sub CommandButton2_Click()
  Dim i As Integer
  Dim TgR As Range
   
  With MyR.Offset(, 255)
   If WorksheetFunction.Sum(.Cells) = 0 Then
     MsgBox "抽出件数は 0 でした", 48
   Else
     Set TgR = .SpecialCells(3, 1)
   End If
  End With
  For i = 1 To 6
   If TgR Is Nothing Then GoTo NLine
   With UserForm1.Controls("TextBox" & i)
     If .Text <> "" Then
      TgR.Offset(, (256 - i) * -1).Value = .Text
     End If
NLine:
     .Text = ""
   End With
  Next i
  Set TgR = Nothing: Set MyR = Nothing
  Unload UserForm1
End Sub

【39108】Re:フォームへの呼び込み、登録について
発言  Kein  - 06/6/18(日) 1:05 -

引用なし
パスワード
   一行、コードを追加して下さい。CommandButton2_Click の最後の方で

> Next i
  MyR.Offset(, 255).ClearContents '←これを追加
> Set TgR = Nothing: Set MyR = Nothing
> Unload UserForm1
>End Sub

【39212】Re:フォームへの呼び込み、登録について
お礼  レオン  - 06/6/19(月) 21:43 -

引用なし
パスワード
   Kein さん、ご返答ありがとうございます。

すいません、質問の仕方がわかりにくくて。

>  A   B   C   D   E   F
>1  txt1 txt2 txt3 txt4 txt5 txt6
>・・・
と表現させていただいたのは、エクセルの表のことです。
上記のようなエクセルの表をユーザーフォームを利用して
入力するマクロを作成しております。

ユーザーフォーム内のtxt3、txt4、txt6のみを埋めて、すでに
入力された表から、これら全てが一致する行の情報をユーザ
ーフォームに再度呼び込むという操作の話でした。

Kein さんにお答えいただいたコードを用いて頑張ってみます。
ありがとうございました。

7436 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free