כיצד להפוך תאים בעמודה אחת על בסיס ערכים ייחודיים בעמודה אחרת?

נניח שיש לך טווח נתונים שמכיל שתי עמודות, כעת ברצונך להפוך את התאים בעמודה אחת לשורות אופקיות על בסיס ערכים ייחודיים בעמודה אחרת כדי לקבל את התוצאה הבאה. האם יש לך רעיונות טובים לפתור את הבעיה הזו ב-Excel?

להפוך תאים בעמודה אחת על בסיס ערכים ייחודיים עם נוסחאות

להפוך תאים בעמודה אחת על בסיס ערכים ייחודיים עם קוד 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 יחד כדי לקבל את התוצאה הנכונה, ראה צילום מסך:

הערה: בנוסחה לעיל, A2:A16 היא העמודה שברצונך לרשום את הערכים הייחודיים ממנה, ו-D1 הוא התא מעל תא הנוסחה.

2. לאחר מכן גרור את הידית למלא כלפי מטה לתאים כדי לחלץ את כל הערכים הייחודיים, ראה צילום מסך:

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 כדי לקבל את התוצאה, ראה צילום מסך:

הערה: בנוסחה לעיל: B2:B16 היא עמודת הנתונים שברצונך להפוך, A2:A16 היא העמודה שברצונך להפוך את הערכים על בסיסה, ו-D2 מכיל את הערך הייחודי שחילצת בשלב 1.

4. לאחר מכן גרור את הידית למלא לימין התאים שברצונך לרשום בהם את הנתונים שהופכו עד שיוצגו 0, ראה צילום מסך:

5. ואז המשך לגרור את הידית למלא כלפי מטה לטווח התאים כדי לקבל את הנתונים שהופכו כפי שמוצג בתמונה הבאה:

להפוך תאים בעמודה אחת על בסיס ערכים ייחודיים עם קוד VBA

ייתכן והנוסחאות מסובכות מדי בשבילך להבין, כאן, תוכל להריץ את קוד ה-VBA הבא כדי לקבל את התוצאה הרצויה שאתה צריך.

1. החזק את המקשים ALT + F11 כדי לפתוח את חלון Microsoft Visual Basic for Applications.

2. לחץ על Insert > Module, והדבק את הקוד הבא בחלון ה-Module.

קוד 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 כדי להריץ את הקוד הזה, ותיבת דו-שיח תקפוץ כדי להזכיר לך לבחור את טווח הנתונים שברצונך להשתמש בו, ראה צילום מסך:

4. ואז לחץ על כפתור OK, תיבת דו-שיח נוספת תקפוץ כדי להזכיר לך לבחור תא כדי להכניס את התוצאה, ראה צילום מסך:

6. לחץ על כפתור OK, והנתונים בעמודה B הופכו על בסיס הערכים הייחודיים בעמודה A, ראה צילום מסך:

להפוך תאים בעמודה אחת על בסיס ערכים ייחודיים עם Kutools for Excel

אם יש לך את Kutools for Excel, באמצעות מיזוג מתקדם של שורות ופיצול תאים, תוכל לגמור משימה זו במהירות ללא כל נוסחאות או קוד.

לאחר התקנת Kutools for Excel, אנא עשה כלהלן:

1. בחר את טווח הנתונים שברצונך להשתמש בו. (אם ברצונך לשמור על הנתונים המקוריים, אנא העתק והדבק את הנתונים למקום אחר תחילה.)

2. לאחר מכן לחץ על Kutools > Merge & Split > Advanced Combine Rows, ראה צילום מסך:

3. בחלון הדו-שיח Combine Rows Based on Column, אנא בצע את הפעולות הבאות:

(1.) לחץ על שם העמודה שברצונך להפוך את הנתונים על בסיסה, ובחר מפתח ראשי;

(2.) לחץ על עמודה אחרת שברצונך להפוך, ולחץ על מיזוג ולאחר מכן בחר מפריד אחד כדי להפריד את הנתונים המחוברים, כמו רווח, פסיק, נקודתיים ופסיק.

4. לאחר מכן לחץ על כפתור Ok, הנתונים בעמודה B ימחקו ביחד לתוך תא אחד על בסיס העמודה A, ראה צילום מסך:

5. ואז בחר את התאים המחוברים, ולחץ על Kutools > Merge & Split > Split Cells, ראה צילום מסך:

6. בחלון הדו-שיח Split Cells, בחר חלק נתונים מתחת לאפשרות סוג, ולאחר מכן בחר את המפריד שמפריד את הנתונים המחוברים שלך, ראה צילום מסך:

7. לאחר מכן לחץ על כפתור Ok, ובחר תא כדי להכניס את תוצאת הפיצול בתיבת הדו-שיח שהופיעה, ראה צילום מסך:

8. לחץ על OK, ותקבל את התוצאה שאתה צריך. ראה צילום מסך:

הורד והגש לניסיון חינם את Kutools for Excel עכשיו!

הדגמה: להפוך תאים בעמודה אחת על בסיס ערכים ייחודיים עם Kutools for Excel