Excel VBA質問箱 IV

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

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


42688 / 76732 ←次へ | 前へ→

【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

0 hits

【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 お礼

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