Page 1 of 1
ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Fri Aug 25, 2017 3:05 pm
by mr.zatan
Code: Select all
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lrow As Single
Dim AStr As String
Dim Value As Variant
If Not Intersect(Target, Range("D:D")) Is Nothing Then
For Each Value In Target
If Value <> "" Then
Range("E" & Value.Row).Formula = "=" & Target.Address & "*1.1"
End If
Next Value
End If
End Sub
ตาม Code จะเป็นการดึงจากคอลั่ม D แล้วเพิ่มทีล่ะ 1.1
แต่คำตอบที่อยากได้คือ ดึงจากคอลั่ม D แล้วเพิ่ม HIGHT (ค่าจากคอลั่ม D ) CM
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Fri Aug 25, 2017 3:22 pm
by puriwutpokin
คำตอบที่ต้องการคืออะไรครับ คีย์จำนวนในคอลัมน์ D แล้วเพิ่มค่าจากคอลัมน์ D แล้วค่อยมาคูณ 1.1 แสดงผลที่คอลัมน์ E ใช่หรือเปล่าครับอ่านแล้วไม่ค่อยเข้าใจครับ
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Fri Aug 25, 2017 5:15 pm
by mr.zatan
คำตอบตามรูปครับ:
คือ เพิ่มคำว่า HIGHT ไว้ข้างหน้า , CM ไว้ข้างหลัง
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Fri Aug 25, 2017 5:51 pm
by puriwutpokin
Code: Select all
'Other...
"HIGHT "&Target.Address*1.1&" CM"
'Other...
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Sat Aug 26, 2017 8:09 am
by puriwutpokin
แก้ไขครับเปลี่ยนเป็น
Code: Select all
'Other code...
Range("E" & Value.Row).Formula = "=" & """HIGHT "" &" & Target.Address & "*1.1 & "" CM"""
'Other code...
หรือจะเอาแต่ค่าก็ใช้เป็น
Code: Select all
'Other code...
Range("E" & Value.Row).Value = "HIGHT " & Value * 1.1 & " CM"
'Other code...
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Sat Aug 26, 2017 9:17 am
by mr.zatan
ถ้าผมต้องการที่จะใช้กับทุก Sheet ล่ะครับต้องเพิ่ม Code อะไรครับ
Code: Select all
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lrow As Single
Dim AStr As String
Dim Value As Variant
If Not Intersect(Target, Range("D:D")) Is Nothing Then
For Each Value In Target
If Value <> "" Then
Range("E" & Value.Row).Value = "HIGHT " & Value & " CM"
End If
Next Value
End If
End Sub
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Sat Aug 26, 2017 9:41 am
by puriwutpokin
เอาโค้ดนี้ไปวางในระดับ workbook แล้วลบโค้ดเดิมออกจากทุกชีทครับ
Code: Select all
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Lrow As Single
Dim AStr As String
Dim Value As Variant
If Not Intersect(Target, Range("D:D")) Is Nothing Then
For Each Value In Target
If Value <> "" Then
Range("E" & Value.Row).Value = "HIGHT " & Value * 1.1 & " CM"
End If
Next Value
End If
End Sub
Re: ใส่ข้อมูล อัตโนมัติ (VBA)
Posted: Sat Aug 26, 2017 11:01 am
by mr.zatan
ขอบคุณครับ