• چگونه متون را در یک ستون بدون تکرار در اکسل بپیوندیم؟

    چگونه متون را در یک ستون بدون تکرار در اکسل بپیوندیم؟

    آیا می دانید چگونه متون را از یک ستون به یک سلول بدون تکرار در اکسل بپیوندید؟ و اگر متن ها را در یک ستون بدون تکرار بر اساس مقدار سلول خاص بپیوندید چه؟ در این مقاله روش هایی برای حل مشکلات ارائه شده است.

    همانطور که در تصویر زیر نشان داده شده است، می خواهید متون ستون A را بدون تکرار به یک سلول واحد بپیوندید. لطفا به شرح زیر عمل کنید.

    1. یک سلول خالی را انتخاب کنید، فرمول زیر را در آن کپی کنید و کلیدهای Alt + Shift + Enter را همزمان فشار دهید.

    =TEXTJOIN(", ", TRUE, IF(MATCH(A2:A12, A2:A12, 0)=MATCH(ROW(A2:A12), ROW(A2:A12)), A2:A12, ""))

    نکته: در فرمول «،» جداکننده متون ترکیبی است. A2:A12 سلول های ستونی است که به هم می پیوندید. لطفا آنها را در صورت نیاز تغییر دهید.

    اکنون متون در ستون مشخص شده بدون تکرار به هم متصل می شوند.


      Join Text را در یک ستون بدون تکرار بر اساس مقدار سلول دیگر با کد VBA بپیوندید.

    گاهی اوقات، ممکن است نیاز به پیوستن متون در یک ستون بدون تکرار بر اساس مقدار در سلول دیگر داشته باشید، همانطور که در تصویر زیر نشان داده شده است، می توانید آن را به صورت زیر دریافت کنید.

    .

    1. در کاربرگ حاوی متن هایی که به آنها ملحق خواهید شد، کلیدهای Alt + F11 را فشار دهید تا پنجره Microsoft Visual Basic for Applications باز شود.

    2. در پنجره Microsoft Visual Basic for Applications، روی Insert > Module کلیک کنید و سپس کد VBA زیر را در پنجره کد ماژول کپی کنید.

    کد VBA: متن ها را در یک ستون بدون تکرار بر اساس مقدار سلول دیگر بپیوندید

    Sub JoinTextsWithoutDuplicates()
    'Updated by Extendoffice 20190924
        Dim xRg As Range
        Dim xArr As Variant
        Dim xCell As Range
        Dim xTxt As String
        Dim I As Long
        Dim xDic As Object
        Dim xValue
        Dim xStr, xStrValue As String
        Dim xB As Boolean
        On Error Resume Next
        xTxt = ActiveWindow.RangeSelection.Address
        Set xRg = Application.InputBox("Please select the data range", "Kutools for Excel", xTxt, , , , , 8)
        Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
        If xRg Is Nothing Then Exit Sub
        If xRg.Areas.Count > 1 Then
            MsgBox "Does not support multiple selections", , "Kutools for Excel"
            Exit Sub
        End If
        If xRg.Columns.Count <> 2 Then
            MsgBox "There must be only two columns in the selected range", , "Kutools for Excel"
            Exit Sub
        End If
        xArr = xRg
        Set xDic = CreateObject("Scripting.Dictionary")
        xDic.CompareMode = 1
        For I = 1 To UBound(xArr)
            If Not xDic.Exists(xArr(I, 1)) Then
                xDic.Item(xArr(I, 1)) = xDic.Count + 1
                xArr(xDic.Count, 1) = xArr(I, 1)
                xArr(xDic.Count, 2) = xArr(I, 2)
            Else
                xStrValue = xArr(I, 2)
               xB = True
                For Each xStr In Split(xArr(xDic.Item(xArr(I, 1)), 2), ",")
                    If xStr = xStrValue Then
                        xB = False
                        Exit For
                    End If
                Next
                If xB Then
                xArr(xDic.Item(xArr(I, 1)), 2) = xArr(xDic.Item(xArr(I, 1)), 2) & "," & xArr(I, 2)
                End If
            End If
        Next
        Sheets.Add.Cells(1).Resize(xDic.Count, 2).Value = xArr
    End Sub
    
    نظرات ارسال شده ارسال نظر جدید
    برای تبادل نظر، می بایست در سایت وارد شوید

    ورود به سایت
تماس سبد خرید بالا