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

 วิธีการเปลี่ยนเซลล์ในคอลัมน์หนึ่งตามค่าที่ไม่ซ้ำกันในคอลัมน์อื่น

สมมติว่าคุณมีช่วงข้อมูลที่มีสองคอลัมน์ตอนนี้คุณต้องการเปลี่ยนเซลล์ในคอลัมน์หนึ่งเป็นแถวแนวนอนตามค่าที่ไม่ซ้ำกันในคอลัมน์อื่นเพื่อให้ได้ผลลัพธ์ต่อไปนี้ คุณมีแนวคิดดีๆในการแก้ปัญหานี้ใน Excel หรือไม่?

doc เปลี่ยนค่าเฉพาะ 1

ย้ายเซลล์ในคอลัมน์เดียวตามค่าที่ไม่ซ้ำกันด้วยสูตร

ย้ายเซลล์ในคอลัมน์เดียวตามค่าที่ไม่ซ้ำกันด้วยรหัส VBA

ย้ายเซลล์ในคอลัมน์เดียวตามค่าที่ไม่ซ้ำกันด้วย Kutools for Excel


ด้วยสูตรอาร์เรย์ต่อไปนี้คุณสามารถแยกค่าที่ไม่ซ้ำกันและเปลี่ยนข้อมูลที่เกี่ยวข้องเป็นแถวแนวนอนได้โปรดทำดังนี้:

1. ป้อนสูตรอาร์เรย์นี้: = INDEX ($ A $ 2: $ A $ 16, MATCH (0, COUNTIF ($ D $ 1: $ D1, $ A $ 2: $ A $ 16), 0)) ลงในเซลล์ว่างตัวอย่างเช่น D2 แล้วกด Shift + Ctrl + Enter คีย์เข้าด้วยกันเพื่อให้ได้ผลลัพธ์ที่ถูกต้องดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 2

หมายเหตุ: ในสูตรข้างต้น A2: A16 คือคอลัมน์ที่คุณต้องการแสดงรายการค่าที่ไม่ซ้ำกันและ D1 คือเซลล์ที่อยู่เหนือเซลล์สูตรนี้

2. จากนั้นลากที่จับเติมลงไปที่เซลล์เพื่อแยกค่าที่ไม่ซ้ำกันทั้งหมดดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 3

3. จากนั้นป้อนสูตรนี้ลงในเซลล์ E2: =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0)และอย่าลืมกด Shift + Ctrl + Enter คีย์เพื่อรับผลลัพธ์ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 4

หมายเหตุ: ในสูตรข้างต้น: B2: B16 คือข้อมูลคอลัมน์ที่คุณต้องการเปลี่ยน A2: A16 คือคอลัมน์ที่คุณต้องการเปลี่ยนค่าตามและ D2 มีค่าเฉพาะที่คุณแยกออกมาในขั้นตอนที่ 1

4. จากนั้นลากที่จับเติมไปทางขวาของเซลล์ที่คุณต้องการแสดงรายการข้อมูลที่ย้ายจนกระทั่งแสดง 0 ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 5

5. จากนั้นลากที่จับเติมลงไปยังช่วงของเซลล์เพื่อรับข้อมูลที่ย้ายตามภาพหน้าจอต่อไปนี้:

doc เปลี่ยนค่าเฉพาะ 6


อาจเป็นสูตรที่ซับซ้อนสำหรับคุณที่จะเข้าใจที่นี่คุณสามารถเรียกใช้รหัส VBA ต่อไปนี้เพื่อให้ได้ผลลัพธ์ที่คุณต้องการ

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

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

รหัส VBA: ย้ายเซลล์ในคอลัมน์หนึ่งตามค่าที่ไม่ซ้ำกันในคอลัมน์อื่น:

Sub transposeunique()
'updateby Extendoffice
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCol  As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
       (xRg.Areas.Count > 1) Then
        MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
        Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
        xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
        xCrit = xCol.Item(i)
        xOutRg.Offset(i, 0) = xCrit
        xRg.AutoFilter Field:=1, Criteria1:=xCrit
        Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
        If xVRg.Count > xCount Then xCount = xVRg.Count
        xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
        xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
End Sub

3. จากนั้นกด F5 คีย์เพื่อเรียกใช้รหัสนี้และกล่องพร้อมต์จะปรากฏขึ้นเพื่อเตือนให้คุณเลือกช่วงข้อมูลที่คุณต้องการใช้ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 7

4. จากนั้นคลิก OK ปุ่มกล่องข้อความอีกอันจะปรากฏขึ้นเพื่อเตือนให้คุณเลือกเซลล์ที่จะใส่ผลลัพธ์ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 8

6. คลิก OK และข้อมูลในคอลัมน์ B ถูกย้ายตามค่าที่ไม่ซ้ำกันในคอลัมน์ A ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 9


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

Kutools สำหรับ Excel : ด้วย Add-in ของ Excel ที่มีประโยชน์มากกว่า 300 รายการทดลองใช้ฟรีโดยไม่มีข้อ จำกัด ใน 30 วัน.

หลังจากการติดตั้ง Kutools สำหรับ Excelโปรดดำเนินการดังนี้:

1. เลือกช่วงข้อมูลที่คุณต้องการใช้ (หากคุณต้องการเก็บข้อมูลต้นฉบับโปรดคัดลอกและวางข้อมูลไปยังตำแหน่งอื่นก่อน)

2. จากนั้นคลิก Kutools > ผสานและแยก > แถวรวมขั้นสูงดูภาพหน้าจอ:

3. ใน รวมแถวตามคอลัมน์ โปรดดำเนินการดังต่อไปนี้:

(1. ) คลิกชื่อคอลัมน์ที่คุณต้องการเปลี่ยนข้อมูลตามและเลือก คีย์หลัก;

(2. ) คลิกคอลัมน์อื่นที่คุณต้องการเปลี่ยนแล้วคลิก รวมกัน จากนั้นเลือกตัวคั่นหนึ่งตัวเพื่อแยกข้อมูลที่รวมกันเช่นช่องว่างลูกน้ำเครื่องหมายอัฒภาค

doc เปลี่ยนค่าเฉพาะ 11

4. จากนั้นคลิก Ok ข้อมูลในคอลัมน์ B ถูกรวมเข้าด้วยกันในเซลล์เดียวตามคอลัมน์ A ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 12

5. จากนั้นเลือกเซลล์ที่รวมกันแล้วคลิก Kutools > ผสานและแยก > แยกเซลล์ดูภาพหน้าจอ:

6. ใน แยกเซลล์ ใหเลือก แยกเป็นคอลัมน์ ภายใต้ ชนิดภาพเขียน จากนั้นเลือกตัวคั่นที่แยกข้อมูลรวมของคุณดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 14 14

7. จากนั้นคลิก Ok และเลือกเซลล์เพื่อใส่ผลการแยกในกล่องโต้ตอบที่โผล่ออกมาดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 15

8. คลิก OKและคุณจะได้รับผลลัพธ์ตามที่คุณต้องการ ดูภาพหน้าจอ:

doc เปลี่ยนค่าเฉพาะ 16

ดาวน์โหลดและทดลองใช้ Kutools for Excel ฟรีทันที!


Kutools สำหรับ Excel: ด้วย Add-in ของ Excel ที่มีประโยชน์มากกว่า 300 รายการให้ทดลองใช้ฟรีโดยไม่มีข้อ จำกัด ใน 30 วัน ดาวน์โหลดและทดลองใช้ฟรีทันที!

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

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
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (56)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะไปในทิศทางตรงกันข้ามได้อย่างไร จากหลายคอลัมน์เป็นคอลัมน์เดียว? ขอบคุณล่วงหน้า! ทิม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มันยอดเยี่ยมมาก ฉันมี excel ที่มีค่าที่ไม่ซ้ำกันประมาณ 2000 ค่าในแถว A และไม่สามารถจัดการแบบฝึกหัดนี้ได้หากไม่ได้รับความช่วยเหลือจากคุณ ขอบคุณมาก.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขั้นตอนแรกล้มเหลว =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) ให้ข้อผิดพลาด Value Not Available
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันแค่อยากจะทำตรงกันข้าม เหมือนกับว่าฉันได้ผลลัพธ์สุดท้ายแล้ว และฉันต้องการบรรลุขั้นตอนแรก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
กำลังหาอยู่เหมือนกันครับ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณพบวิธีแก้ปัญหาสำหรับสถานการณ์ตรงข้ามหรือไม่? ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
อยากทำตรงกันข้ามเหมือนกัน คุณมีวิธีแก้ปัญหาอะไรบ้าง?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีทุกคน,
เพื่อให้ได้ผลลัพธ์ตรงกันข้ามตามตัวอย่างของบทความนี้ คุณสามารถใช้โค้ด VBA ต่อไปนี้: (หมายเหตุ:เมื่อเลือกช่วงข้อมูลที่คุณต้องการย้าย โปรดยกเว้นแถวส่วนหัว)

ย้ายย่อยUnique_2()
Dim xLRow, xLCount ตราบใด
Dim xRg เป็นช่วง
Dim xOutRg เป็นช่วง
Dim xObjRRg เป็นช่วง
Dim xTxt เป็นสตริง
Dim xCount ตราบใด
Dim xVRg เป็นช่วง
เกี่ยวกับข้อผิดพลาดต่อไป
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("โปรดเลือกช่วงข้อมูล:", "Kutools สำหรับ Excel", xTxt, , , , , 8)
ตั้งค่า xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
ถ้า xRg ไม่มีอะไร ให้ออกจาก Sub
ถ้า (xRg.Rows.count < 2) หรือ _
(xRg.Areas.count > 1) จากนั้น
MsgBox "การเลือกไม่ถูกต้อง", , "Kutools สำหรับ Excel"
ออกจาก Sub
End If
Set xOutRg = Application.InputBox("โปรดเลือกช่วงเอาต์พุต (ระบุหนึ่งเซลล์):", "Kutools for Excel", xTxt, , , , , 8)
ถ้า xOutRg ไม่มีอะไร ให้ออกจาก Sub
Application.ScreenUpdating = เท็จ
xLCount = xRg.Columns.count
สำหรับ xLRow = 1 ถึง xRg.Rows.count
ตั้งค่า xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
xObjRRg.คัดลอก
xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = เท็จ
ช่วง(เซลล์(xOutRg.Row, xOutRg.Column), เซลล์(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
ตั้งค่า xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
ต่อไป
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
วิธีการทำทรานสโพสถ้าคอลัมน์ B ไม่มีค่าเฉพาะ แต่ยังต้องการค่าเหล่านั้น
เคทีอี100
เคทีอี100
สมมติว่าเป็นสองธุรกรรมที่แตกต่างกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคุณ Didin,

คุณสามารถให้ปัญหาของคุณชัดเจนขึ้นหรือลงรายละเอียดได้หรือไม่?
คุณสามารถแทรกภาพหน้าจอตัวอย่างสำหรับปัญหาของคุณได้
ขอขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี,
คุณช่วยฉันด้วยข้อกำหนดด้านล่างได้ไหม
สินค้า ----- สั่งซื้อ
KTE ------ 100KTE ------ 200KTO ------ 300KTO ------ 300
ผลผลิตที่คาดหวัง
สินค้า ----- สั่งซื้อ ----- สั่งซื้อ ------ สั่งซื้อ
KTE ------ 100 ------ 200
KTO ------ 300 ------ 300







ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันก็ต้องการเหมือนกัน ฉันต้องการแสดง 100 สองครั้งคือถ้ามีใน data
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณช่วยแนะนำสูตรสำหรับสิ่งนั้นได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณเคยได้รับการตอบสนอง/การแก้ปัญหาสำหรับความท้าทายนี้หรือไม่? ฉันมีอันเดียวกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มีวิธีการทำเช่นนี้ในทางกลับกันหรือไม่? เช่นข้อมูลในแถวที่มีความยาวแตกต่างกันและเรียงลำดับเป็นสองคอลัมน์? ดูเอกสารแนบ.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันต้องการเปลี่ยนค่าที่ซ้ำกันด้วย (ค่าทั้งหมด - ไม่ซ้ำกัน + ซ้ำกัน) และไม่ใช่แค่ค่าที่ไม่ซ้ำ คุณสามารถให้สูตรนั้นด้วยได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันก็ต้องการเหมือนกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณเคยได้รับการตอบสนอง/การแก้ปัญหาสำหรับความท้าทายนี้หรือไม่? ฉันมีอันเดียวกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ด้วยสูตรด้านล่าง:

=IFERROR(INDEX($B$2:$B$45, MATCH(0, COUNTIF($D2:D2,$B$2:$B$45)+IF($A$2:$A$10<>$D2, 1, 0), 0)), 0)

ฉันจะย้ายข้อมูลโดยใช้การจับคู่โดยประมาณได้อย่างไร สมมติว่าฉันต้องการดึงค่าทั้งหมดจากคอลัมน์ B ที่ตรงกับ 9 อักขระ / หลักแรกจากคอลัมน์ A คอลัมน์ B มี 11 ตัวอักษรในขณะที่ A เพียง 9 ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันต้องทำตรงกันข้ามกับสิ่งนี้ ฉันมีหลายคอลัมน์ที่เกี่ยวข้องกับ id แถว และฉันต้องการวางลงในสองคอลัมน์
ตัวอย่างเช่นฉันมี
แถว, ค่า, ค่า1, ค่า2, ค่า3, ค่า4, ค่า..225
100, โลมา, 255, 9--, ซาร่าห์, เจมสัน, ....
179 เร้าเตอร์น้ำท่วม เจสัน 89 จมูก



อยากได้แบบนี้บ้าง
100, ปลาโลมา
100, 255
100, 9--
100 ซาร่าห์
100, เจมสัน
179, เราเตอร์
179 น้ำท่วม
179 เจสัน
179, 89
179 จมูก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีเดฟ
เพื่อแก้ปัญหาของคุณ โปรดใช้โค้ด VBA ด้านล่าง: (หมายเหตุ: เมื่อคุณเลือกช่วงข้อมูลที่คุณต้องการย้าย โปรดยกเว้นแถวส่วนหัว)

ย้ายย่อยUnique_2()
Dim xLRow, xLCount ตราบใด
Dim xRg เป็นช่วง
Dim xOutRg เป็นช่วง
Dim xObjRRg เป็นช่วง
Dim xTxt เป็นสตริง
Dim xCount ตราบใด
Dim xVRg เป็นช่วง
เกี่ยวกับข้อผิดพลาดต่อไป
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("โปรดเลือกช่วงข้อมูล:", "Kutools สำหรับ Excel", xTxt, , , , , 8)
ตั้งค่า xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
ถ้า xRg ไม่มีอะไร ให้ออกจาก Sub
ถ้า (xRg.Rows.count < 2) หรือ _
(xRg.Areas.count > 1) จากนั้น
MsgBox "การเลือกไม่ถูกต้อง", , "Kutools สำหรับ Excel"
ออกจาก Sub
End If
Set xOutRg = Application.InputBox("โปรดเลือกช่วงเอาต์พุต (ระบุหนึ่งเซลล์):", "Kutools for Excel", xTxt, , , , , 8)
ถ้า xOutRg ไม่มีอะไร ให้ออกจาก Sub
Application.ScreenUpdating = เท็จ
xLCount = xRg.Columns.count
สำหรับ xLRow = 1 ถึง xRg.Rows.count
ตั้งค่า xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
xObjRRg.คัดลอก
xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = เท็จ
ช่วง(เซลล์(xOutRg.Row, xOutRg.Column), เซลล์(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
ตั้งค่า xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
ต่อไป
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณ มันใช้งานได้ดี คุณช่วยฉันได้ 2 วัน! :)
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี สกายหยาง
กรุณาแบ่งปันรหัสสำหรับ 3 คอลัมน์ ด้านล่างนี้เป็นตัวอย่าง:
ฉันต้องการข้อมูลเช่น: yogesh@gmail.com community 1 view only community 2 view only ...... goyal@gmail.com community 1 view only community 2 view only........

ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ygoyal

เพื่อแก้ปัญหาของคุณ โปรดใช้รหัสด้านล่าง:

ย้ายย่อยUnique_2()

Dim xLRow, xLCount ตราบใด

Dim xRg เป็นช่วง

Dim xOutRg เป็นช่วง

Dim xObjRRg เป็นช่วง

Dim xTxt เป็นสตริง

Dim xCount ตราบใด

Dim xVRg เป็นช่วง

xC, xI, xI1, xI2 เป็นจำนวนเต็ม

เกี่ยวกับข้อผิดพลาดต่อไป

xTxt = ActiveWindow.RangeSelection.Address

Set xRg = Application.InputBox("โปรดเลือกช่วงข้อมูล:", "Kutools สำหรับ Excel", xTxt, , , , , 8)

ตั้งค่า xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)

ถ้า xRg ไม่มีอะไร ให้ออกจาก Sub

ถ้า (xRg.Rows.Count < 2) หรือ _

(xRg.Areas.Count > 1) จากนั้น

MsgBox "การเลือกไม่ถูกต้อง", , "Kutools สำหรับ Excel"

ออกจาก Sub

End If

Set xOutRg = Application.InputBox("โปรดเลือกช่วงเอาต์พุต (ระบุหนึ่งเซลล์):", "Kutools for Excel", xTxt, , , , , 8)

ถ้า xOutRg ไม่มีอะไร ให้ออกจาก Sub

Application.ScreenUpdating = เท็จ

xLCount = xRg.Columns.Count

สำหรับ xLRow = 1 ถึง xRg.Rows.Count

ตั้งค่า xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)

เกี่ยวกับข้อผิดพลาดต่อไป

xC = (xObjRRg.Count Mod 2)

ถ้า xC <> 0 แล้ว

xC = Int(xObjRRg.Count / 2) + 1

อื่น

xC = Int(xObjRRg.Count / 2)

End If

xI1 = 1

xI2 = 2

สำหรับ xI = 1 ถึง xC

ช่วง(xObjRRg.Item(xI1), xObjRRg.Item(xI2)).คัดลอก

xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = เท็จ

xOutRg.Value = xRg.Cells(xLRow, 1).ค่า

ตั้งค่า xOutRg = xOutRg.Offset(RowOffset:=1)

xI1 = xI1 + (2)

xI2 = xI2 + (2)

ต่อไป

ต่อไป

Application.ScreenUpdating = จริง

ย่อยสิ้นสุด



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

ย่อย transposeunique()

'updateby Extendoffice

Dim xLR นานเท่านาน

มืดมนตราบนานเท่านาน

Dim xCrit เป็นสตริง

Dim xCol เป็นคอลเลกชั่นใหม่

Dim xRg เป็นช่วง

Dim xOutRg เป็นช่วง

Dim xTxt เป็นสตริง

Dim xCount ตราบใด

Dim xVRg เป็นช่วง

xFRg หรี่, xSRg, xCRg เป็นช่วง

เกี่ยวกับข้อผิดพลาดต่อไป

xTxt = ActiveWindow.RangeSelection.Address

Set xRg = Application.InputBox("โปรดเลือกช่วงข้อมูล (เฉพาะ 3 คอลัมน์):", "Kutools for Excel", xTxt, , , , , 8)

ตั้งค่า xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)

ถ้า xRg ไม่มีอะไร ให้ออกจาก Sub

ถ้า (xRg.Columns.Count <> 3) หรือ _

(xRg.Areas.Count > 1) จากนั้น

MsgBox "ช่วงที่ใช้เป็นเพียงพื้นที่เดียวที่มีสองคอลัมน์ , , "Kutools for Excel"

ออกจาก Sub

End If

Set xOutRg = Application.InputBox("โปรดเลือกช่วงเอาต์พุต (ระบุหนึ่งเซลล์):", "Kutools for Excel", xTxt, , , , , 8)

ถ้า xOutRg ไม่มีอะไร ให้ออกจาก Sub

ตั้งค่า xOutRg = xOutRg.Range(1)

xLRow = xRg.Rows.Count

สำหรับผม = 2 ถึง xLRow

xCol.เพิ่ม xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value

ต่อไป

Application.ScreenUpdating = เท็จ

Application.ScreenUpdating = เท็จ

สำหรับฉัน = 1 ถึง xCol.Count

xCrit = xCol.Item(i)

xOutRg.Offset(i, 0) = xCrit

xRg.AutoFilter ฟิลด์:=1, Criteria1:=xCrit

ตั้งค่า xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)

ถ้า xVRg.Count > xCount แล้ว xCount = xVRg.Count

ตั้งค่า xSRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)

ตั้งค่า xCRg = xOutRg.Offset(i, 1)

สำหรับแต่ละ xFRg ใน xSRg

xFRg.คัดลอก

xCRg.PasteSpecial

xRg.Range("B1")).Copy

xCRg.Offset(-(i), 0).PasteSpecial

xFRg.Offset(0, 1).คัดลอก

ตั้งค่า xCRg = xCRg.Offset(0, 1)

xCRg.PasteSpecial

xRg.Range("c1")).Copy

xCRg.Offset(-(i), 0).PasteSpecial

ตั้งค่า xCRg = xCRg.Offset(0, 1)

ต่อไป

Application.CutCopyMode = เท็จ

ต่อไป

xRg.Item(1).คัดลอก

xOutRg.PasteSpecial

xRg.ตัวกรองอัตโนมัติ

Application.ScreenUpdating = จริง

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Bro ฉันลองใช้รหัสนี้ แต่ excel หยุดทำงานเมื่อฉันเรียกใช้รหัสนี้และไม่เห็นผลลัพธ์จากรหัสด้านบน โปรดแนะนำว่าจะทำอย่างไรในกรณีนี้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
รหัสทำงานได้ดีในสมุดงานของฉัน คุณใช้ Excel เวอร์ชันใด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เอ็มเอส เอ็กเซล 2016
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสทำงานได้ดีใน Excel 2016 ของฉันเช่นกัน โปรดลองใช้ข้อมูลช่วง smalll ก่อน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ได้ทดสอบใน 160 บันทึก แต่ในที่ยังคงซ้ำกันอยู่ที่นั่น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Skyyang ชอบสิ่งนี้ มีโอกาสใดที่คุณจะทำให้มันทำงานสี่คอลัมน์ได้ อีกครั้งเพียงแค่ใช้สองตัวแรกเป็นตัวเปรียบเทียบหรือสามารถเลือกจำนวนคอลัมน์ก่อนเลือกได้ดีกว่า? ฉันดูสคริปต์ของคุณแล้ว ไม่รู้จะทำสำเร็จได้อย่างไร...
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Skyyang ชอบสิ่งนี้ มีโอกาสใดที่คุณจะทำให้มันทำงานสี่คอลัมน์ได้ อีกครั้งเพียงแค่ใช้สองตัวแรกเป็นตัวเปรียบเทียบหรือสามารถเลือกจำนวนคอลัมน์ก่อนเลือกได้ดีกว่า? ฉันดูสคริปต์ของคุณแล้ว ไม่รู้จะทำสำเร็จได้อย่างไร...
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
พี่ชายกรุณาช่วยในเรื่องนี้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีพี่ ยังรอความช่วยเหลือจากคุณอยู่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เช่นเดียวกับเดฟ ฉันต้องทำตรงกันข้ามกับสิ่งนี้ ตารางที่ 2 ที่จะย้ายไปยังตารางที่ 1 อินพุต ตารางที่ 2, เอาต์พุต ตารางที่ 1
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
=INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) ทำงานให้ฉันเปลี่ยนค่าเฉพาะของคอลัมน์เป็นค่าใหม่ คอลัมน์ แต่...มีวิธีโฆษณาในฟังก์ชันการเรียงลำดับเพื่อให้คอลัมน์ใหม่ที่สร้างขึ้นถูกย้ายในลำดับจากน้อยไปมากหรือไม่


ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ต้องการผลลัพธ์ที่เหมือนกัน แต่สำหรับคอลัมน์ที่กำหนดไว้ล่วงหน้าที่จะเลือกจะเป็น ($A,$B) และต้องการตำแหน่งคอลัมน์ผลลัพธ์บน $D$1
ใครมีไอเดียเด็ดๆ ช่วยได้เพียบ!!!!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี เราเพิ่มแต่ละแถวและให้ผลลัพธ์ในคอลัมน์เดียวด้วยฟังก์ชันข้างต้นได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจึงทำงานบริษัท เรามีคอลัมน์ข้อมูลต่างๆ เช่น นามสกุล ชื่อ ยศ ส่วน หมายเลขโทรศัพท์ ที่อยู่ มีวิธีใดบ้างที่ฉันสามารถใช้สูตรที่คล้ายกันเพื่อย้ายข้อมูลทั้งแถวไปยังคอลัมน์ตามชื่อ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
=INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) ทำงานให้ฉันเปลี่ยนค่าเฉพาะของคอลัมน์ A เป็นค่าใหม่ คอลัมน์ แต่...มีวิธีรับค่าทั้งหมดในคอลัมน์ B ที่จะย้ายตามที่ระบุด้านล่างหรือไม่:

วันที่สั่งซื้อผลิตภัณฑ์ สั่งซื้อ สั่งซื้อ สั่งซื้อ สั่งซื้อ สั่งซื้อ สั่งซื้อ
KTE 100 3/3/2019 KTE 100 100 100 200 100 150 100
KTO 150 3/3/2019 KTO 150 100 200 100 150 200
KTE 100 3/4/2019 ธปท. 150 100 200 150 100 200
KTO 100 3/4/2019 COD 200 150 100 150
KTO 200 3/5/2019
KTE 100 3/5/2019
ธปท. 150 3/5/2019
ธปท. 100 3/6/2019
KTO 100 3/6/2019
KTE 200 3/6/2019
ธปท. 200 3/7/2019
COD 200 3/7/2019
KTE 100 3/7/2019
KTO 150 3/7/2019
ธปท. 150 3/8/2019
KTE 150 3/8/2019
COD 150 3/8/2019
ธปท. 100 3/9/2019
ธปท. 200 3/10/2019
COD 100 3/10/2019
KTO 200 3/10/2019
COD 150 3/11/2019
KTE 100 3/11/2019
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มาโครไม่ทำงาน มันเพิ่งคัดลอกเนื้อหาในเซลล์ A1
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีชุดข้อมูลในคอลัมน์ A (Unique ID) - E แต่ละแถวมีข้อมูลตาม ID# มีหลายแถวสำหรับแต่ละ ID# แต่ฉันต้องการหนึ่งแถวต่อ ID# พร้อมข้อมูลอื่นๆ ทั้งหมดในคอลัมน์ ( จะมีความยาวขั้นต่ำ 5 คอลัมน์และสูงสุด 25 คอลัมน์ ขึ้นอยู่กับจำนวน ID ที่ไม่ซ้ำแต่ละรายการ) ฉันพบรหัส แต่ใช้งานได้สองคอลัมน์เท่านั้น ฉันต้องต่อสี่คอลัมน์ (ไม่รวม ID) แล้วจึงคั่นหลังจากเรียกใช้มาโคร (งานมาก) สำหรับข้อมูล 15,000 แถว การดำเนินการนี้ใช้เวลานานกว่าปกติ มีมาโครคอลัมน์ที่ไม่มีที่สิ้นสุดที่จะใช้งานได้หรือไม่ ขอบคุณล่วงหน้าทุกคนสำหรับความช่วยเหลือของคุณ!
รหัส รหัส ST CODE# DATE
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีชุดข้อมูลที่มี ID หลายตัวในคอลัมน์ A และได้เชื่อมต่อข้อมูลในคอลัมน์ B ฉันใช้สูตรด้านบนและแก้ไขเล็กน้อยเพื่อที่ฉันจะย้ายเซลล์ในคอลัมน์ B ไปเป็นแถวตาม ID ที่ไม่ซ้ำกัน เชื่อมโยงกับคอลัมน์ A สูตรที่ใช้ในการระบุ ID ที่ไม่ซ้ำคือ: =INDEX($A$2:$A$13409, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$13409), 0)). สูตรที่ใช้ในการแปลงคือ: =IFERROR(INDEX($B$2:$B$13409, MATCH(0, IF($A$2:$A$13409<>$D2, 1, 0)+COUNTIF($D2: D2,$B$2:$B$13409), 0)), "N/A") ทั้งที่ให้ไว้ในบทความ มีการเปลี่ยนแปลงเพียงเล็กน้อยเท่านั้น

ปัญหาคือชุดข้อมูลของฉันในคอลัมน์ B มีข้อมูลซ้ำกัน บางครั้งอาจปรากฏขึ้นทีละรายการ และฉันต้องการให้ค่าทั้งหมดในคอลัมน์แสดงในแถว

รูปภาพที่แนบมาคือสิ่งที่ฉันต้องการให้ตารางแสดง (นี่คือขนาดตัวอย่างขนาดเล็ก ชุดข้อมูลจริงมีมากกว่า 13,000 รายการ) สิ่งที่เกิดขึ้นตอนนี้คือเมื่อพบค่าซ้ำจะไม่นับ
เช่นแถวที่ 9 สำหรับ ID 11980 ตอนนี้แสดงเฉพาะ 0 -31.79 -0.19 -0.74 N/AN/A .... เมื่อสิ่งที่ฉันต้องการให้แสดงแทนคือ 0 0 -31.79 -0.19 -0.74 0 0 N/AN/A ...

มีวิธีแก้ไขปัญหานี้และแก้ไขหรือไม่?

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



คอลัมน์ A คอลัมน์ B คอลัมน์ C



ประเทศ1 ปี1 มูลค่า1

ประเทศ1 ปี2 มูลค่า2

ประเทศ1 ปี3 มูลค่า3,



ประเทศ2 ปี1 มูลค่า1

ประเทศ2 ปี3 มูลค่า3,

...........



ฉันต้องรวม 3 คอลัมน์เหล่านี้ในตารางดังนี้:

ปีที่1 ปีที่2 ปีที่3 ................................ ปีX



ประเทศ1 มูลค่า1 มูลค่า2 มูลค่า3

Country2 Value1 #Missing Value3

.....
.....
.....

CountryX Valuex .................





ปัญหาที่ฉันเผชิญคือสำหรับข้อมูลบางส่วนในคอลัมน์ A ฉันไม่มีค่าสำหรับบางปีในแต่ละปีเท่านั้น (เช่น ประเทศที่ 2 มีค่าขาดหายไปสำหรับปีที่ 2)





มีวิธีแก้ไขปัญหานี้และแก้ไขหรือไม่?



ขอขอบคุณล่วงหน้า!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณช่วยแชร์รหัสได้ไหมหากมี 2 คอลัมน์ที่จะคัดลอกแทนที่จะเป็น 1 ด้านล่างเป็นตัวอย่าง
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
โหลดเพิ่มเติม
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ