ใส่ข้อมูล อัตโนมัติ (VBA)

[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

[puriwutpokin]

คำตอบที่ต้องการคืออะไรครับ คีย์จำนวนในคอลัมน์ D แล้วเพิ่มค่าจากคอลัมน์ D แล้วค่อยมาคูณ 1.1 แสดงผลที่คอลัมน์ E ใช่หรือเปล่าครับอ่านแล้วไม่ค่อยเข้าใจครับ

[mr.zatan]

คำตอบตามรูปครับ:
คือ เพิ่มคำว่า HIGHT ไว้ข้างหน้า , CM ไว้ข้างหลัง

[puriwutpokin]

Code: Select all

'Other... 
"HIGHT "&Target.Address*1.1&" CM"
'Other...

[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...

[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

[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

[mr.zatan]

ขอบคุณครับ