Note: The other languages of the website are Google-translated. Back to English

วิธีการต่อเซลล์ถ้ามีค่าเดียวกันในคอลัมน์อื่นใน Excel

รวมกันถ้าเหมือนกัน

ตามที่แสดงภาพหน้าจอด้านซ้าย สมมติว่าคุณจำเป็นต้องต่อเซลล์ในคอลัมน์ที่สองโดยยึดตามเซลล์ค่าเดียวกันในคอลัมน์แรก คุณจะบรรลุเป้าหมายได้อย่างไร

ในบทความนี้ เราจะมาแนะนำสามวิธีที่จะช่วยให้คุณบรรลุเป้าหมาย

เชื่อมต่อเซลล์ถ้าค่าเดียวกันกับสูตรและตัวกรอง

เชื่อมต่อเซลล์ถ้าค่าเดียวกันกับรหัส VBA
เชื่อมต่อเซลล์ได้อย่างง่ายดายหากค่าเดียวกันกับ Kutools for Excel


เชื่อมต่อเซลล์ถ้าค่าเดียวกันกับสูตรและตัวกรอง

ด้วยสูตรด้านล่างคุณสามารถเชื่อมต่อเนื้อหาของเซลล์ที่เกี่ยวข้องหากคอลัมน์อื่นมีค่าเดียวกันใน Excel

1. เลือกเซลล์ว่างนอกเหนือจากคอลัมน์ที่สอง (ที่นี่เราเลือกเซลล์ C2) ป้อนสูตร = IF (A2 <> A1, B2, C1 & "," & B2) ลงในแถบสูตรแล้วกด เข้าสู่ กุญแจ

2. จากนั้นเลือกเซลล์ C2 แล้วลาก Fill Handle ลงไปที่เซลล์ที่คุณต้องการเชื่อมต่อกัน

3. ใส่สูตร = IF (A2 <> A3, CONCATENATE (A2, "," ", C2," ""), ") ลงในเซลล์ D2 แล้วลาก Fill Handle ลงไปที่เซลล์ที่เหลือ

4. เลือกเซลล์ D1 แล้วคลิก ข้อมูล > กรอง. ดูภาพหน้าจอ:

5. คลิกลูกศรดรอปดาวน์ในเซลล์ D1 ยกเลิกการเลือก (ช่องว่าง) จากนั้นคลิกที่ไฟล์ OK ปุ่ม

คุณสามารถเห็นเซลล์ที่เรียงต่อกันหากค่าคอลัมน์แรกเหมือนกัน

หมายเหตุ: ในการใช้สูตรข้างต้นให้สำเร็จค่าเดียวกันในคอลัมน์ A ต้องต่อเนื่องกัน


รวมเซลล์ในคอลัมน์ได้อย่างง่ายดายหากมีค่าเดียวกันในคอลัมน์อื่น:

กับ Kutools สำหรับ Excel's แถวรวมขั้นสูง ยูทิลิตี้คุณสามารถรวมเซลล์ในคอลัมน์ได้อย่างง่ายดายหากค่าเดียวกันออกจากคอลัมน์อื่นใน Excel ตามที่แสดงด้านล่าง ดาวน์โหลด Kutools for Excel ทันที! (เส้นทางฟรี 30 วัน)

ขัดแย้งกัน


เชื่อมต่อเซลล์ถ้าค่าเดียวกันกับรหัส VBA

นอกจากสูตรแล้วในส่วนนี้เราจะแสดงวิธีใช้รหัส VBA เพื่อเชื่อมต่อเซลล์หากมีค่าเท่ากัน

1 กด อื่น ๆ + F11 คีย์เพื่อเปิด แอปพลิเคชัน Microsoft Visual Basic หน้าต่าง

2 ใน แอปพลิเคชัน Microsoft Visual Basic หน้าต่างคลิก สิ่งที่ใส่เข้าไป > โมดูล. จากนั้นคัดลอกและวางโค้ดด้านล่างลงในไฟล์ โมดูล หน้าต่าง

รหัส VBA: เชื่อมต่อเซลล์หากมีค่าเท่ากัน

Sub ConcatenateCellsIfSameValues()
	Dim xCol As New Collection
	Dim xSrc As Variant
	Dim xRes() As Variant
	Dim I As Long
	Dim J As Long
	Dim xRg As Range
	xSrc    = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
	Set xRg = Range("D1")
	On Error Resume Next
	For I = 2 To UBound(xSrc)
		xCol.Add xSrc(I, 1), TypeName(xSrc(I, 1)) & CStr(xSrc(I, 1))
	Next I
	On Error GoTo 0
	ReDim xRes(1 To xCol.Count + 1, 1 To 2)
	xRes(1, 1) = "No"
	xRes(1, 2) = "Combined Color"
	For I = 1 To xCol.Count
		xRes(I + 1, 1) = xCol(I)
		For J = 2 To UBound(xSrc)
			If xSrc(J, 1) = xRes(I + 1, 1) Then
				xRes(I + 1, 2) = xRes(I + 1, 2) & ", " & xSrc(J, 2)
			End If
		Next J
		xRes(I + 1, 2) = Mid(xRes(I + 1, 2), 2)
	Next I
	Set xRg = xRg.Resize(UBound(xRes, 1), UBound(xRes, 2))
	xRg.NumberFormat = "@"
	xRg = xRes
	xRg.EntireColumn.AutoFit
End Sub

หมายเหตุ:

1. D1 ในบรรทัด ตั้งค่า xRg = ช่วง ("D1") หมายความว่าผลลัพธ์จะถูกวางไว้ในเซลล์ D1

2. ไม่ใช่และ สีรวม ในบรรทัด xRes (1, 1) = "ไม่ใช่" และ xRes (1, 2) = "สีรวม" คือส่วนหัวของคอลัมน์ที่เรียงต่อกัน คุณสามารถเปลี่ยนได้ตามต้องการ

3 กด F5 คีย์เพื่อรันโค้ดจากนั้นคุณจะได้ผลลัพธ์ที่ต่อกันในช่วงที่ระบุ


เชื่อมต่อเซลล์ได้อย่างง่ายดายหากค่าเดียวกันกับ Kutools for Excel (หลายคลิก)

หากสองวิธีข้างต้นมีความซับซ้อนสำหรับคุณที่นี่เราจะแสดงให้คุณเห็น แถวรวมขั้นสูง ประโยชน์ของ Kutools สำหรับ Excel คุณสามารถต่อเซลล์ได้อย่างง่ายดายโดยใช้เครื่องหมายจุลภาคอัฒภาคและอื่น ๆ หากมีค่าเดียวกันในคอลัมน์อื่น

ก่อนที่จะใช้ Kutools สำหรับ Excelโปรด ดาวน์โหลดและติดตั้งในตอนแรก.

1. เลือกช่วงที่มีเซลล์ที่คุณต้องการเชื่อมต่อจากนั้นคลิก Kutools > ผสานและแยก > แถวรวมขั้นสูง. ดูภาพหน้าจอ:

2 ใน แถวรวมขั้นสูง คุณต้องทำดังนี้

  • 2.1) เลือกคอลัมน์ที่มีค่าเดียวกับที่คุณต้องการเชื่อมต่อเซลล์ตามจากนั้นคลิกไฟล์ คีย์หลัก ปุ่ม
  • 2.2) เลือกคอลัมน์ที่คุณต้องการเชื่อมต่อเซลล์คลิก รวมกัน จากนั้นระบุตัวคั่นจากเมนูบริบท (ที่นี่ฉันระบุ จุลภาค).
  • 2.3) คลิกปุ่ม OK ปุ่ม

ตอนนี้เซลล์จะเชื่อมต่อกันตามคอลัมน์คีย์หลัก

  หากคุณต้องการทดลองใช้ยูทิลิตีนี้ฟรี (30 วัน) กรุณาคลิกเพื่อดาวน์โหลดแล้วไปใช้การดำเนินการตามขั้นตอนข้างต้น


เชื่อมต่อเซลล์ได้อย่างง่ายดายหากค่าเดียวกันกับ Kutools for Excel


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (17)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ดูเหมือนจะเชื่อมกับเซลล์มากกว่า 2 เซลล์โดยใช้สูตรและตัวกรองไม่ได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะรวมคอลัมน์ที่มีชื่อเดียวกันได้อย่างไร เช่น คอลัมน์ที่หนึ่งอ่านเคนยาตลอด และคอลัมน์ที่ 2 อ่านเป็นภาษาตะวันตก Nyanza (ปรากฏมากกว่าสิบครั้ง) และคอลัมน์ 3 สามชื่อเขต อยากทราบว่าแต่ละอำเภอมีอะไรบ้างแต่เก็บคอลัมน์ไว้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียน เจฟฟรี่ย์

โปรดลองใช้ยูทิลิตี้ Advanced Combine Rows ที่เรากล่าวถึงในวิธีที่สองข้างต้น หากคุณต้องการเก็บคอลัมน์ไว้ โปรดทำสำเนาช่วงเดิมและทำทุกอย่างในช่วงที่คัดลอกมา

ระบุคอลัมน์จังหวัดเป็นคีย์หลัก ตั้งค่าคอลัมน์ 1 เป็นเก็บไว้ที่ 1 จากนั้นตั้งค่าคอลัมน์อำเภอเป็น คำนวณ > นับ

หลังจากนั้นจะได้กี่อำเภอในแต่ละจังหวัด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณลักษณะการต่อกันไม่ทำงาน รวมแถวทั้งหมดเป็นเซลล์เดียวแม้จะมีปุ่มต่างกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียน คุณมาริสา
ขออภัย ฉันไม่แน่ใจว่าฉันได้รับคำถามของคุณ มีสามวิธีในบทความ คุณหมายถึงคุณลักษณะที่เชื่อมต่อกันแบบใด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันขอบคุณคุณมากสำหรับสูตรเหล่านี้ งานมหัศจรรย์!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นี่คือสิ่งที่ฉันต้องการ...ขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ด้วยการใช้มาโคร VBA และได้ผลลัพธ์ที่ยอดเยี่ยม ฉันได้ลองปรับแต่งเล็กน้อยตามความต้องการของฉันแล้ว แต่ใช้งานไม่ได้ หวังว่าคุณจะช่วยได้

ฉันจะเปลี่ยนบิตใดเพื่อให้ต่อกับคอลัมน์เฉพาะ ไม่ใช่คอลัมน์ทางด้านขวาของ xSrc = Range โดยตรง

ขอบคุณสำหรับการทำงานที่ยอดเยี่ยมของคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
หรือเป็นทางเลือกที่ดีกว่า ถ้าคุณมี 3 คอลัมน์แทนที่จะเป็น 2 และพบว่าซ้ำกันในคอลัมน์ A (เช่นตัวอย่างของคุณ) คุณสามารถต่อคอลัมน์ B ลงในเซลล์และคอลัมน์ C ลงในเซลล์ที่แยกจากกันได้หรือไม่ ดังนั้น ถ้าคุณมีคอลัมน์ของ Number, Colour, Age คุณสามารถรวมสีและอายุลงในคอลัมน์ต่าง ๆ เมื่อค้นหารายการที่ซ้ำกันใน Number ได้หรือไม่ หวังว่าจะสมเหตุสมผล!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันใช้ VBA นี้สำหรับสเปรดชีตจำนวนมากและมันยอดเยี่ยมมาก แต่สเปรดชีตมีขนาดใหญ่มาก 50 แถว และดูเหมือนว่าจะไม่ทำงานอีกต่อไป ถ้าฉันใช้มันใน 1000 แถว มันใช้งานได้ดี แต่ชุดข้อมูลขนาดใหญ่ ดูเหมือนจะไม่สามารถรับมือได้ ไม่มีข้อผิดพลาดเพียงแค่ไม่มีผลลัพธ์ ความช่วยเหลือใด ๆ ที่จะได้รับการชื่นชม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เจมส์ hi,
ฉันทดสอบโค้ดตามที่คุณกล่าวถึงแล้ว แต่ก็ยังใช้ได้ดีในกรณีของฉัน แม้ว่าฉันจะตั้งค่าแถวเป็น 1000+
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี

ดูเหมือนว่า 2 สูตรของคุณผิด :

=IF(A2<>A3,CONCATENATE(A2,",""",C2,""""),"") คุณต้องเปลี่ยน "A2" เป็น "D1" เนื่องจากคุณจะต้องการเพิ่มสตริงลงในเซลล์ก่อนหน้า

เช่นเดียวกับสูตรนี้:

=IF(A2<>A1,B2,C1 & "," & B2) : เปลี่ยน C1 เป็น D1


ขอแสดงความนับถือ


Harry
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ก่อนอื่นขอขอบคุณสำหรับการสร้างแหล่งข้อมูลนี้ ฉันพยายามคิดเรื่องนี้มาสองสามชั่วโมงแล้วและฉันก็ติดอยู่ ฉันกำลังใช้ 'เชื่อมเซลล์ถ้ามีค่าเท่ากัน' แต่สคริปต์ของฉันกำลังดูที่คอลัมน์ "D" แทนที่จะเป็น "A ฉันไม่สามารถหาวิธีทำให้มันใช้คอลัมน์อื่นสำหรับข้อมูลนอกเหนือจากคอลัมน์ถัดไปได้ ในกรณีของฉัน ฉันต้องการให้ดูที่คอลัมน์ "D" เพื่อดูว่ามีค่าเท่ากันหรือไม่ ถ้าใช่ มันจะดึงข้อมูลจากคอลัมน์ "H" และนำข้อมูลจากคอลัมน์ "H" ไปไว้ในเซลล์ ในคอลัมน์ "J" ฉันจะสลับไปใช้คอลัมน์ "H" สำหรับข้อมูลได้อย่างไร ขอบคุณ


Sub ConcatenateCellsIfSameValues() ย่อย
Dim xCol เป็นคอลเลกชั่นใหม่
Dim xSrc เป็นตัวแปร
Dim xRes() เป็น Variant
หรี่ฉันนาน
Dim J ตราบ
Dim xRg เป็นช่วง
xSrc = ช่วง ("D1", เซลล์ (Rows.Count, "D") สิ้นสุด (xlUp)). ปรับขนาด (, 2)
ตั้งค่า xRg = ช่วง ("J1")
เกี่ยวกับข้อผิดพลาดต่อไป
สำหรับฉัน = 2 ถึง UBound(xSrc)
xCol.Add xSrc(I, 1), TypeName(xSrc(I, 1)) & CStr(xSrc(I, 1))
ถัดไปฉัน
เมื่อเกิดข้อผิดพลาด GoTo 0
ReDim xRes (1 ถึง xCol.Count + 1, 1 ถึง 2)
xRes(1, 1) = "ไม่"
xRes(1, 2) = "ผลิตภัณฑ์"
สำหรับฉัน = 1 ถึง xCol.Count
xRes(I + 1, 1) = xCol(ผม)
สำหรับ J = 2 ถึง UBound(xSrc)
ถ้า xSrc(J, 1) = xRes(I + 1, 1) แล้ว
xRes(I + 1, 2) = xRes(I + 1, 2) & vbCrLf & xSrc(J, 2)
End If
ถัดไป J
xRes(I + 1, 2) = กลาง (xRes(I + 1, 2), 2)
ถัดไปฉัน
ตั้งค่า xRg = xRg.Resize(UBound(xRes, 1), UBound(xRes, 2))
xRg.NumberFormat = "@"
xRg = xRes
xRg.ทั้งคอลัมน์ ปรับพอดีอัตโนมัติ
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
"ฉันไม่รู้ว่าจะใช้คอลัมน์อื่นสำหรับข้อมูลได้อย่างไรนอกจากคอลัมน์ที่อยู่ติดกัน ในกรณีของฉัน ฉันต้องการให้ดูที่คอลัมน์ 'D' เพื่อดูว่าค่าเท่ากันหรือไม่ และถ้า ดังนั้น มันจะดึงข้อมูลจากคอลัมน์ 'H' และใส่ข้อมูลจากคอลัมน์ 'H' ลงในเซลล์ในคอลัมน์ 'J'"

คุณเคยคิดออกนี้หรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันแค่อยากจะขอบคุณ มันไม่ใช่สิ่งที่ฉันต้องการ แต่ผู้ชายช่วยให้ฉันคิดออกว่าต้องทำอย่างไร

ฉันมีตารางที่มีชื่อบุคคลอยู่ในคอลัมน์ A วันที่ในคอลัมน์ B และชื่อเครื่องมือที่ใช้ในส่วนหัวของคอลัมน์ C:G ในแต่ละคอลัมน์จะมี "Y" หากใช้เครื่องมือนั้นในวันนั้น และเว้นว่างไว้หากไม่มี (สำหรับข้อมูล: บุคคลเดียวกันสามารถระบุรายชื่อได้มากกว่าหนึ่งครั้งและอาจใช้เครื่องมือเดียวกันมากกว่าหนึ่งครั้ง) ในหน้าแยก (สรุป) ฉันต้องการแสดงรายการเครื่องมือทั้งหมดที่แต่ละคนใช้ภายในช่วงวันที่ โดยระบุเฉพาะเครื่องมือแต่ละรายการที่พวกเขาใช้ ครั้งหนึ่งในเซลล์เดียวกัน ในหน้านี้ ชื่อของบุคคลนั้นอยู่ในคอลัมน์ A ประเภทเครื่องมือที่ใช้ในคอลัมน์ B และคอลัมน์ผู้ช่วยอยู่ในคอลัมน์ G:K นี่คือสิ่งที่ฉันได้รับ:
คอลัมน์ผู้ช่วยแรก (G2):
=IF(COUNTIFS(Table7[Person's Name],A2,Table7[Screw Driver],"Y",Table7[Date],">="&1/1/20,Table7[Date],"<="&3/31/20),"Screw Driver","")
ในคอลัมน์ตัวช่วยสุดท้าย (K2):
=IF(COUNTIFS(Table7[Person's Name],A2,Table7[Hammer],"Y",Table7[Date],">="&1/1/20,Table7[Date],"<="&3/31/20),IF(J2="","Hammer",J2&"/"&"Hammer"),J2)

ใน B2 ฉันเพิ่งเข้ามา =K2

ขอบคุณอีกครั้งและฉันหวังว่านี่จะช่วยใครซักคน EZPD
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี รหัส VBA จะถูกปรับอย่างไรถ้าฉันต้องการรวมเซลล์ในคอลัมน์ M ตามข้อมูลที่ซ้ำกันในคอลัมน์ A
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Kristin หากต้องการรวมเซลล์ในคอลัมน์ M ตามข้อมูลซ้ำในคอลัมน์ A ให้ลองใช้ VBA ด้านล่าง ในโค้ด  O1 เป็นเซลล์แรกที่จะแสดงผลลัพธ์ M คือคอลัมน์ที่คุณจะรวมตามคอลัมน์ที่ซ้ำกันในคอลัมน์ A A1 และ A แสดงถึงเซลล์แรกและคอลัมน์ที่ซ้ำกันตั้งอยู่ ไม่ และ รวมสี เป็นส่วนหัวของคอลัมน์หลังจากต่อกัน คุณสามารถเปลี่ยนตัวแปรเหล่านี้ได้ตามต้องการ Sub ConcatenateCellsIfSameValues() ย่อย
'ปรับปรุงโดย Extendoffice 20211105
Dim xCol เป็นคอลเลกชั่นใหม่
Dim xSrc เป็นตัวแปร
Dim xSrcValue เป็น Variant
Dim xRes() เป็น Variant
หรี่ฉันนาน
Dim J ตราบ
Dim xRg เป็นช่วง
Dim xResultAddress เป็นสตริง
Dim xMergeAddress เป็นสตริง
Dim xUp เป็นจำนวนเต็ม

xResultAddress = "O1" 'เซลล์ที่จะส่งออกผลลัพธ์
xMergeAddress = "ม" 'คอลัมน์ที่คุณจะรวมตามรายการที่ซ้ำกันในคอลัมน์ A

xSrc = ช่วง ("A1", เซลล์(Rows.Count, "A").End(xlUp)).Resize(, 1)
xUp = ช่วง ("A1", เซลล์(Rows.Count, "A").End(xlUp)).Rows.Count
xSrcValue = ช่วง (xMergeAddress & "1:" & xMergeAddress & xUp)

ตั้งค่า xRg = ช่วง (xResultAddress)
เกี่ยวกับข้อผิดพลาดต่อไป
สำหรับฉัน = 2 ถึง UBound(xSrc)
xCol.Add xSrc(I, 1), TypeName(xSrc(I, 1)) & CStr(xSrc(I, 1))
ถัดไปฉัน

เมื่อเกิดข้อผิดพลาด GoTo 0
ReDim xRes (1 ถึง xCol.Count + 1, 1 ถึง 2)
xRes(1, 1) = "ไม่"
xRes(1, 2) = "สีรวม"
สำหรับฉัน = 1 ถึง xCol.Count
xRes(I + 1, 1) = xCol(ผม)
สำหรับ J = 2 ถึง UBound(xSrc)
ถ้า xSrc(J, 1) = xRes(I + 1, 1) แล้ว
xRes(I + 1, 2) = xRes(I + 1, 2) & ", " & xSrcValue(J, 1)
End If
ถัดไป J
xRes(I + 1, 2) = กลาง (xRes(I + 1, 2), 2)
ถัดไปฉัน
ตั้งค่า xRg = xRg.Resize(UBound(xRes, 1), UBound(xRes, 2))
xRg.NumberFormat = "@"
xRg = xRes
xRg.ทั้งคอลัมน์ ปรับพอดีอัตโนมัติ
ย่อยสิ้นสุด
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ