By เจฟฟ์ ในวันอาทิตย์ที่ 18 ธันวาคม 2022
โพสต์ใน Kutools สำหรับ Excel
ตอบกลับ 2
การกดไลค์ 0
เข้าชม 4.9K
โหวต 0
ฉันได้คัดลอก VBA สำหรับการคัดลอกข้อมูลจากเซลล์ไปยังแถวเดียวกันในคอลัมน์ต่างๆ และเปลี่ยนแปลงเพื่อให้ฉันสามารถเปลี่ยนเซลล์ในคอลัมน์ F และบันทึกค่าลงในคอลัมน์ E แต่เมื่อฉันลองก็ไม่มีอะไรเกิดขึ้น ใครช่วยบอกฉันทีว่าฉันทำอะไรผิด? ฉันต้องการประทับวันที่ในคอลัมน์ G เมื่อฉันทำการเปลี่ยนแปลง

ฉันหวังว่าจะสามารถทำสิ่งเดียวกันได้เมื่อฉันเปลี่ยนเซลล์ในคอลัมน์ I เพื่อบันทึกลงในคอลัมน์ H และประทับวันที่ที่เปลี่ยนแปลงในคอลัมน์ J

ความช่วยเหลือใด ๆ ที่จะได้รับการชื่นชมอย่างมาก


Dim xRg เป็นช่วง
Dim xChangeRg เป็นช่วง
Dim xDependRg เป็นช่วง
Dim xDic เป็นพจนานุกรมใหม่
Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
หรี่ฉันนาน
Dim xCell เป็นช่วง
Dim xDCell เป็นช่วง
Dim xHeader เป็นสตริง
Dim xCommText เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
Application.EnableEvents = เท็จ
xHeader = "ค่าก่อนหน้า :"
x = xDic.คีย์
สำหรับฉัน = 0 ถึง UBound(xDic.Keys)
ตั้งค่า xCell = ช่วง (xDic.Keys (I))
ตั้งค่า xDcell = เซลล์ (xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
ถัดไป
Application.EnableEvents = จริง
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
แผ่นงานย่อยส่วนตัว_SelectionChange(ByVal Target As Range)
Dim I, J ตราบ
Dim xRgArea เป็นช่วง
เมื่อเกิดข้อผิดพลาด GoTo Label1
ถ้า Target.Count > 1 แล้วออกจาก Sub
Application.EnableEvents = เท็จ
ตั้งค่า xDependRg = Target.Dependents
ถ้า xDependRg ไม่มีอะไรเลย ให้ไปที่ Label1
ถ้าไม่ใช่ xDependRg ก็ไม่มีอะไรแล้ว
ตั้ง xDependRg = Intersect(xDependRg, ช่วง("F:F"))
End If
ป้ายที่ 1:
ตั้ง xRg = จุดตัด (เป้าหมาย, ช่วง ("F:F"))
ถ้า (ไม่ใช่ xRg คือไม่มีอะไร) และ (ไม่ใช่ xDependRg คือไม่มีอะไร) ถ้าอย่างนั้น
ตั้งค่า xChangeRg = สหภาพ (xRg, xDependRg)
ElseIf (xRg ไม่มีอะไร) และ (ไม่ใช่ xDependRg ไม่มีอะไร) จากนั้น
ตั้งค่า xChangeRg = xDependRg
ElseIf (ไม่ใช่ xRg ไม่มีอะไรเลย) และ (xDependRg ไม่มีอะไรเลย) จากนั้น
ตั้งค่า xChangeRg = xRg
อื่น
Application.EnableEvents = จริง
ออกจาก Sub
End If
xDic.RemoveAll
สำหรับ I = 1 ถึง xChangeRg.Areas.Count
ตั้งค่า xRgArea = xChangeRg.Areas(I)
สำหรับ J = 1 ถึง xRgArea.Count
xDic.Add xRgArea(J).ที่อยู่, xRgArea(J).สูตร
ถัดไป
ถัดไป
ตั้ง xChangeRg = ไม่มีอะไร
ตั้งค่า xRg = Nothing
ตั้ง xDependRg = ไม่มีอะไร
Application.EnableEvents = จริง
ย่อยสิ้นสุด
อัพเดท

VBA ใช้งานได้แล้ว! โปรดดูรหัสด้านล่าง ฉันแค่ต้องการความช่วยเหลือในการแก้ไข ดังนั้นเมื่อฉันเปลี่ยนเซลล์ใน Column I มันจะบันทึกค่าเป็น Column H


Dim xRg เป็นช่วง
Dim xChangeRg เป็นช่วง
Dim xDependRg เป็นช่วง
Dim xDic เป็นพจนานุกรมใหม่
Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
หรี่ฉันนาน
Dim xCell เป็นช่วง
Dim xDCell เป็นช่วง
Dim xHeader เป็นสตริง
Dim xCommText เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
Application.EnableEvents = เท็จ
xHeader = "ค่าก่อนหน้า :"
x = xDic.คีย์
สำหรับฉัน = 0 ถึง UBound(xDic.Keys)
ตั้งค่า xCell = ช่วง (xDic.Keys (I))
ตั้งค่า xDcell = เซลล์ (xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
ถัดไป

ถ้า Target.Column = 6 แล้ว
Application.EnableEvents = เท็จ
เซลล์ (Target.Row, 7) ค่า = วันที่
Application.EnableEvents = จริง
End If

ถ้า Target.Column = 9 แล้ว
Application.EnableEvents = เท็จ
เซลล์ (Target.Row, 10) ค่า = วันที่
Application.EnableEvents = จริง
End If
Application.EnableEvents = จริง
ย่อยสิ้นสุด
แผ่นงานย่อยส่วนตัว_SelectionChange(ByVal Target As Range)
Dim I, J ตราบ
Dim xRgArea เป็นช่วง
เมื่อเกิดข้อผิดพลาด GoTo Label1
ถ้า Target.Count > 1 แล้วออกจาก Sub
Application.EnableEvents = เท็จ
ตั้งค่า xDependRg = Target.Dependents
ถ้า xDependRg ไม่มีอะไรเลย ให้ไปที่ Label1
ถ้าไม่ใช่ xDependRg ก็ไม่มีอะไรแล้ว
ตั้ง xDependRg = Intersect(xDependRg, ช่วง("F:F"))
End If
ป้ายที่ 1:
ตั้ง xRg = จุดตัด (เป้าหมาย, ช่วง ("F:F"))
ถ้า (ไม่ใช่ xRg คือไม่มีอะไร) และ (ไม่ใช่ xDependRg คือไม่มีอะไร) ถ้าอย่างนั้น
ตั้งค่า xChangeRg = สหภาพ (xRg, xDependRg)
ElseIf (xRg ไม่มีอะไร) และ (ไม่ใช่ xDependRg ไม่มีอะไร) จากนั้น
ตั้งค่า xChangeRg = xDependRg
ElseIf (ไม่ใช่ xRg ไม่มีอะไรเลย) และ (xDependRg ไม่มีอะไรเลย) จากนั้น
ตั้งค่า xChangeRg = xRg
อื่น
Application.EnableEvents = จริง
ออกจาก Sub
End If
xDic.RemoveAll
สำหรับ I = 1 ถึง xChangeRg.Areas.Count
ตั้งค่า xRgArea = xChangeRg.Areas(I)
สำหรับ J = 1 ถึง xRgArea.Count
xDic.Add xRgArea(J).ที่อยู่, xRgArea(J).สูตร
ถัดไป
ถัดไป
ตั้ง xChangeRg = ไม่มีอะไร
ตั้งค่า xRg = Nothing
ตั้ง xDependRg = ไม่มีอะไร

Application.EnableEvents = จริง
ย่อยสิ้นสุด
·
1 ปีที่ผ่านมา
·
0 ชอบ
·
0 คะแนน
·
0 คอมเมนต์
·
แค่จะอธิบายให้ชัดเจน นี่จะเป็นการเพิ่มเติมสิ่งที่กำลังทำอยู่ ฉันต้องการติดตามการเปลี่ยนแปลงที่เกิดขึ้นในทั้งคอลัมน์ F และคอลัมน์ I ขออภัยในความสับสน
·
1 ปีที่ผ่านมา
·
0 ชอบ
·
0 คะแนน
·
0 คอมเมนต์
·
ดูโพสต์แบบเต็ม