| |
>▼通りすがりの者 さん：
いつもお世話になり、ありがとうございます。
>>ごめんなさい。説明不足ですみませんでした。
>>>1.「123」という文字が書かれたテキストファイルはユーザーフォームを
>>>利用してコード番号001-01-2004-03-24に入力します。
>>>001-01-2004-03-24.txtをデスクトップに作成する。
>>>できればフォルダを付けてからテキストファイルを保存します。
>>
>>「123」という文字が書かれたテキストファイルは開けばいいんですか？
>はいそうです。
>>ユーザーフォームへの入力は人間の作業と言うことですか？
>はいそうです。人間の作業で入力してこのコード番号を
>一致してテキストファイルから読込します。
>>ユーザーフォームにはコード番号を入力するテキストボックスがあるということですか？
>はいテキストボックスがあります。入力してボタンを押して読込します。
>
>>イマイチ質問の内容が私には理解できません。
>>
>>>
>>>2.別のBookを開いて、ユーザーフォームを開いて001-01-2004-03-24の
>>>リストボックスを表示、選択し、001-01-2004-03-24.txtファイルを
>>>読み込んで、指定のシートを「123」を取り込んで計算し、結果を出る
>>>ようにしたい。
>>
>>こちらも質問の主旨が分かりかねます。
>>
>>ある程度、ご自身でマクロの記録をされてみては？
>>
>>その上で分からないことを具体的にコードを掲載するとかして質問をされてはいかがでしょうか？
マクロで修正したがエラーを出すけど、
コード間違いでしょうか？ ご指南おねがいします。
Private Sub CommandButton1_Click() '入力完了ボタン
'Changeイベントがおきないように。
Application.EnableEvents = False
Dim myFile As String
Dim fNo As Integer
Dim lRow As Integer, i As Integer
Dim ws As Worksheet, Rpos As Long
Set ws = Worksheets("顧客データ")
ws.Visible = True
ws.Activate
'A列（番号）の最終行をチェックし、そこに通し番号を入力します。
Rpos = ws.Range("A65536").End(xlUp).Row + 1
'B列（氏名）にテキストボックスの会社名を入力します。
With ws
If Rpos = 3 Then
.Cells(Rpos, 1).Value = 1
Else
.Cells(Rpos, 1).Value = .Cells(Rpos - 1, 1).Value + 1
End If
'
.Cells(Rpos, 2).Value = TextBox1.Text '会社名
.Cells(Rpos, 3).Value = TextBox2.Text '本部名コード
.Cells(Rpos, 4).Value = TextBox3.Text '支部名コード
.Cells(Rpos, 5).Value = TextBox5.Text '実施日(年度）
.Cells(Rpos, 6).Value = TextBox6.Text '月
.Cells(Rpos, 7).Value = TextBox7.Text '日
End With
'本部コード（001〜999）− 支部コード（01〜99）- 年度 - 月 −日.csvをインプットし、保存します。
myFile = "C:\Documents" & TextBox2.Text & "-" & TextBox3.Text & "-" & TextBox5.Text _
& "-" & TextBox6 & "-" & TextBox7 & ".csv"
Worksheets("Work").Activate
lRow = Range("A1").CurrentRegion.Rows
fNo = FreeFile
Open myFile For Output As #fNo
For i = 1 To lRow
Write #fNo, Cells(i, 1), Cells(i, 2), Cells(i, 3) _
; Cells(i, 4), Cells(i, 5), Cells(i, 6) _
; Cells(i, 7), Cells(i, 8), Cells(i, 9), Cells(i, 10) _
; Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), sells(i, 15) _
; Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19), sells(i, 20) _
; Cells(i, 21), Cells(i, 22), Cells(i, 23), Cells(i, 24), sells(i, 25) _
; Cells(i, 26), Cells(i, 27), Cells(i, 28), Cells(i, 29), sells(i, 30) _
; Cells(i, 31), Cells(i, 32), Cells(i, 33), Cells(i, 34), sells(i, 35) _
; Cells(i, 36), Cells(i, 37), Cells(i, 38), Cells(i, 39), sells(i, 40) _
; Cells(i, 41), Cells(i, 42), Cells(i, 43), Cells(i, 44), sells(i, 45) _
; Cells(i, 46), Cells(i, 47), Cells(i, 48), Cells(i, 49), sells(i, 50) _
; Cells(i, 51), Cells(i, 52), Cells(i, 53), Cells(i, 54), sells(i, 55) _
; Cells(i, 56), Cells(i, 57), Cells(i, 58), Cells(i, 59), sells(i, 60) _
; Cells(i, 61), Cells(i, 62), Cells(i, 63), Cells(i, 64), sells(i, 65) _
; Cells(i, 66),
Next
Close #fNo
End Sub
'TextBox_Clear
Dim obj As Control
For Each obj In Me.Controls
If TypeName(obj) = "TextBox" Then
obj.Text = ""
End If
Next
'
Me.OptionButton1.Value = True
'行の複製
RowCopy Rpos
'
TextBox1.SetFocus
Application.EnableEvents = True
End Sub
|
|
- 04/3/24(水) 1:14 -
