| |
▼UO3 さん：
はい、通常では動いているのですが、
実際のはUO3さんに書いていただきましたのを
少し変えさせていただきまして↓コレ↓になります。
Private Sub コマンド登録_Click()
Dim SiName As String
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim s4 As String
Dim s5 As String
Dim s6 As String
Dim sx As Variant
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim i As Long
Dim wCol As Long
Dim z As Long
Dim k1 As String
Dim k2 As String
Dim k3 As String
Dim k4 As String
Dim k5 As String
Dim k6 As String
Dim LastRow As Long
Dim Last_Row As Long
Dim RG As Range
'コンボボックスで選んだ名前を変数SiNameに格納する
SiName = コンボ名前.Value
Worksheets(SiName).Activate
'E列にコードを略称に変換して入れる
'G列に数量を入れる
s1 = テキスト物品コード1.Value
s2 = テキスト物品コード2.Value
s3 = テキスト物品コード3.Value
s4 = テキスト物品コード4.Value
s5 = テキスト物品コード5.Value
s6 = テキスト物品コード6.Value
k1 = テキスト数量1.Value
k2 = テキスト数量2.Value
k3 = テキスト数量3.Value
k4 = テキスト数量4.Value
k5 = テキスト数量5.Value
k6 = テキスト数量6.Value
If Len(s1 & s2 & s3 & s4 & s5 & s6) = 0 Then
MsgBox "コードは何ですか？"
Exit Sub
End If
Application.ScreenUpdating = False
Set sh1 = Sheets(SiName)
Set sh2 = Sheets("ｺｰﾄﾞ一覧")
If IsEmpty(sh1.Range("E1").Value) Then
z = 1
Else
z = sh1.Range("E" & sh1.Rows.Count).End(xlUp).Row + 1
End If
sh1.Range("E" & z).Value = sh2.Range("B1").Value
wCol = sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column + 2
sh2.Cells(1, wCol) = sh2.Range("A1").Value
i = 2
For Each sx In Array(s1, s2, s3, s4, s5, s6)
If Len(sx) > 0 Then
sh2.Cells(i, wCol).Value = "'=" & sx
i = i + 1
End If
Next
sh2.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=sh2.Cells(1, wCol).CurrentRegion, _
CopyToRange:=sh1.Range("E" & z), Unique:=False
If z > 1 Then Rows(z).Delete
sh2.Columns(wCol).Clear
Application.ScreenUpdating = True
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LastRow + 1).Value = k1
k1 = ""
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LastRow + 1).Value = k2
k2 = ""
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LastRow + 1).Value = k3
k3 = ""
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LastRow + 1).Value = k4
k4 = ""
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LastRow + 1).Value = k5
k5 = ""
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LastRow + 1).Value = k6
k6 = ""
'そのシートの有効行数を調べる
With Worksheets(SiName)
Range("a65536").End(xlUp).Offset(1).Select
'C列に受付日を入れる
Selection.Offset(, 2) = テキスト日付.Value
'D列に納期を入れる
Selection.Offset(, 3) = テキスト納期.Value
End With
Set RG = ActiveCell
Range("A" & RG.Row) = Application.WorksheetFunction _
.Max(Range("A:A")) + 1
'入力したコントロールの値を初期化します。（元に戻します。）
テキスト日付.Value = Format(Date, "yyyy/mm/dd")
テキスト納期.Value = Format(Date + 14, "yyyy/mm/dd")
テキスト物品コード1 = ""
テキスト物品コード2 = ""
テキスト物品コード3 = ""
テキスト物品コード4 = ""
テキスト物品コード5 = ""
テキスト物品コード6 = ""
テキスト数量1 = ""
テキスト数量2 = ""
テキスト数量3 = ""
テキスト数量4 = ""
テキスト数量5 = ""
テキスト数量6 = ""
コンボ名前 = ""
テキスト日付.SetFocus
End Sub
よろしくお願いいたします
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
