| |
フォームというのは、もちろんユーザーフォームのことですよね ?
その図を見ると、何かワークシートに直接テキストボックスを
配置したように見えますけど・・。ま、常識的にユーザーフォームであると解釈して
フォームモジュールの先頭から、以下のコードを入れてみて下さい。
シート名などはそちらで適当に修正すること。あと、
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
|
|
Kein
- 06/6/18(日) 1:01 -
