Snasui Excel Forum

... โปรแกรมจะมีการตรววจสอบว่ามีการตรึงแนวอยู่แล้วหรือไม่ หากไม่มีจะตรึงแนวให้ใหม่

ลองนำ Code นี้ไปวางใน Sheet1 แล้วทดสอบดูครับ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Me
If Not .Parent.Windows(1).FreezePanes Then
.Range("d3").Activate
ActiveWindow.FreezePanes = True
End ...

... Show
End With
End Sub

ในแบบที่ 1 นี้ เมื่อผู้ใช้คลิกเลือกวันที่ใน datepickerform แล้ว ฟอร์มจะปิดตัวลงอัตโนมัติ

แบบที่ 2 วางโค๊ดไว้ที่ Worksheet_SelectionChange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("G4"), Target) Is Nothing Then
datepickerform.Show ...

ตัวอย่างการปรับ Code ครับ

ที่ Procedure Worksheet_Selectionchange

เปลี่ยน If Target.Address(0, 0) = "B4" Then เป็น If Target.Column = 2 Then

ได้แล้วครับอาจารย์ ขอสอบถามเพิ่มเติมหน่อยครับ ถ้าอยากให้รายการ Bom อัพเดททันที ที่มีการเพิ่ม หรือลด เลข 1 ในกรอบ โดยไม่ต้องไปกดที่ ปุ่ม
Code นี้ใช้แล้วสามารถทำได้หรือเปล่า มีผลเสียอะไรมั้ยครับ

... นนั้นได้ ปกติก็จะใช้ VBA ควบคุม ComboBox เข้ามาช่วย

ตัวอย่างการปรับ Code ตามด้านล่างครับ

ใน Sheet5 นำ Code นี้ไปใช้

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
Dim c As Integer
If Target.Count > 1 Then Exit Sub
If Target.Address(0, 0) = "B4" Then
Call ListDropdown ...

... แจ้ง
"Please fill Others(description) in column 'I " และพอกด ok cell กลับไปที่ column I เหมือนเดิมค่ะ ต้องปรับ code ยังไงคะ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("i18:i38,k18:k38")) Is Nothing Then Exit Sub ...

... แจ้ง
"Please fill Others(description) in column 'I " และพอกด ok cell กลับไปที่ column I เหมือนเดิมค่ะ ต้องปรับ code ยังไงคะ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("i18:i38,k18:k38")) Is Nothing Then Exit Sub ...

... เพิ่ม range k18:K38 แล้ว และอยากให้ pop up ไปที่ Row K พอปรับแล้ว ใช้งานไม่ได้ค่ะ รบกวนอาจารย์ช่วยดูให้หน่อยนะคะ ขอบคุณค่ะ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("i18:i38"), Me.Range("k18:k38")) Is Nothing Then ...

ติดปัญหาที่ ไม่ pop up ตรง cell ที่เลือก ค่ะ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("i18:i38")) Is Nothing Then Exit Sub
Application.EnableEvents = False

If Me.Cells(Target.Row, "e").Value = "Office_equipment ...

:D ตัวอย่าง Code เขียนใน Worksheet ที่เกี่ยวข้องครับ


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("i18:i38")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Me.Cells(Target.Row, "e").Value = "" Then ...

ตอนนี้เมื่อแก้ที่ B5 ก็จะทำให้ B9 เปลี่ยนตาม ฺ B5 เท่านั้นตามโค้ดนี้


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("b9") = Range("b5")
Range("b10") = Range("b6")
End Sub


แต่ผมต้องการอยากให้ ทั้ง B5 และ B9 เหมือนกันตลอด คือ
เมื่อแก้ที่ B5 ก็จะทำให้ B9 เปลี่ยนตาม ฺ B5 หร ...

ลองปรับเป็น
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updateby Extendoffice
Application.ScreenUpdating = False
On Error Resume Next
If Target.Column = 5 Then
Sheets(Target.Value).Visible = xlSheetVisible
Sheets("Main").Range("e3").Select
Sheets(Target.Value).Select
End If ...

นี้ค่ะ column E

ivate Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updateby Extendoffice
Application.ScreenUpdating = False
On Error Resume Next
If Target.Column = E Then
Sheets(Target.Value).Visible = xlSheetVisible
Sheets(Target.Value).Select
End If
Application.ScreenUpdating ...

ลองทั้งสองวิธิีแล้ว ไม่ได้น่ะค่ะ ตาม code ที่ให้ link มา

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
‘Updateby Extendoffice
Application.ScreenUpdating = False
On Error Resume Next
If Target.Column = 1 Then
Sheets(Target.Value).Visible = xlSheetVisible
Sheets(Target.Value ...

... Selection.ClearContents
Range("B2").Select
End Sub

และอันนี้เป็นคำสั่งที่ ให้เริ่มColumn ใหม่ (แต่ต้องคีย์เองที่ชีทนั้น)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row >= 10 Then
Cells(Target.Row - 8, Target.Column + 2).Select
End If
End Sub

...ขอออกตัวก่อนว่าไม ...

ต้องใช้เป็น Event โดยไปที่ชีทนั้นๆ ครับ แล้วว่างโค้ดตามนี้
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastRow As Long
lastRow = cells(Rows.Count, 1).End(xlUp).Row - 1
If Not Intersect(Target, Range("B2:N2")) Is Nothing Then
ActiveCell.Resize(lastRow, 1).Value = "/"
End If
End ...

:D You can call 'CopyNonBlankValue' as below.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
' Range("B" & Target.Row).Resize(, 24).Copy RCL4.Cells(Rows.Count).End(xlUp).Offset(1)
Call Module3.CopyNonBlankValue
End Sub

... ลองบันทึก Macro ดูแล้วแก้ไข ติดตรงไหนมาถามต่อครับ

ผมลองใช้ VBA แล้ว ถ้าจะให้ Drop down list ชั้นที่ 2 เป็นค่าว่างก็ต่อเมื่อมีการเปลี่ยนค่า Drop down list ชั้นที่1 ต้องปรับ VBA Code อย่างไรครับ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
activecell.Offset(0, 1).Value = ""
End Sub

ลองปรับเป็นแบบนี้ดูครับ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rw As Long
rw = Cells(Rows.Count, 4).End(xlUp).Row
If Not Intersect(Target, Range("D9:D" & rw)) Is Nothing Then '// ตรวจสอบการคลิกช่วง cell "D8:Dxxx..
Sheets("Sheet2").Range("C7").Value = Target.Value '// ถ ...

... เพิ่มขึ้นได้ และรบกวนเช็ค code ว่ามีวิธีที่น่าจะเขียนได้รวบรัดกว่านี้รบกวนปรับให้ด้วยครับ code อยู่ที่ sheet1 private sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("D9:D24")) Is Nothing Then
Sheets("Sheet2").Range("C7").Value = Target.Value
End ...