Giúp em nối chuối ký tự có điều kiện với ạ (1 người xem)

[ptcuongGDLA]

anh chị giúp em với ạ. em muốn nối chuỗi ký tự ở cột A lại với nhau với điều kiện cột B có giá trị giống nhau ạ. anh chị giúp em gửi vào mail em với ạ "ptcuongGDLA@gmail.com". Em cảm ơn ạ

 

[be_09]

anh chị giúp em với ạ. em muốn nối chuỗi ký tự ở cột A lại với nhau với điều kiện cột B có giá trị giống nhau ạ. anh chị giúp em gửi vào mail em với ạ "ptcuongGDLA@gmail.com". Em cảm ơn ạ

Góp ý cho bạn:
1/ Hình như bạn nhập dữ liệu ngược, đúng ra thửa hay vùng phải nằm trước loại đất, diện tích.
2/ Nên đưa File có chứa cột thửa, loại đất, diện tích nằm đúng vị trí thực tế.
3/ Ngành TNMT, 1 sheet chứa rất nhiều dữ liệu vì vậy bạn nên đăng bài trong Box Lập trìn với Excel (chứ dùng hàm chắc kham không nổi).

 

[snow25]

anh chị giúp em với ạ. em muốn nối chuỗi ký tự ở cột A lại với nhau với điều kiện cột B có giá trị giống nhau ạ. anh chị giúp em gửi vào mail em với ạ "ptcuongGDLA@gmail.com". Em cảm ơn ạ

Bạn dùng hàm này xem được không nhé.

Function noichuoi(ByVal mang As Variant)
Dim Arr, i As Integer, b As Integer, a As Integer, arr1()
Dim dic As Object
   Set dic = CreateObject("scripting.dictionary")
   Arr = mang
   ReDim arr1(1 To UBound(Arr, 1), 1 To 1)
   For i = 1 To UBound(Arr, 1)
       If Not dic.exists(Arr(i, 2)) Then
          a = a + 1
          arr1(a, 1) = Arr(i, 1)
          dic.Add Arr(i, 2), a
       Else
          b = dic.Item(Arr(i, 2))
          arr1(b, 1) = arr1(b, 1) & ";" & Arr(i, 1)
       End If
  Next i
  noichuoi = arr1()
End Function

Cách dùng quét toàn bộ vùng muốn trả kết quả về.Ví dụ Quét vùng E1:E3.Rồi điền công thức.

=noichuoi(A1:B13)

Kết thúc bằng Ctrl+shift+enter.

 

[ptcuongGDLA]

Bạn dùng hàm này xem được không nhé.

Function noichuoi(ByVal mang As Variant)
Dim Arr, i As Integer, b As Integer, a As Integer, arr1()
Dim dic As Object
   Set dic = CreateObject("scripting.dictionary")
   Arr = mang
   ReDim arr1(1 To UBound(Arr, 1), 1 To 1)
   For i = 1 To UBound(Arr, 1)
       If Not dic.exists(Arr(i, 2)) Then
          a = a + 1
          arr1(a, 1) = Arr(i, 1)
          dic.Add Arr(i, 2), a
       Else
          b = dic.Item(Arr(i, 2))
          arr1(b, 1) = arr1(b, 1) & ";" & Arr(i, 1)
       End If
  Next i
  noichuoi = arr1()
End Function

Cách dùng quét toàn bộ vùng muốn trả kết quả về.Ví dụ Quét vùng E1:E3.Rồi điền công thức.

=noichuoi(A1:B13)

Kết thúc bằng Ctrl+shift+enter.

Em làm được rồi ạ, em cảm ơn ạ