Giúp code về lấy giá trị ở vị trí dầu và cuối... (1 người xem)

[nad582]

Chào các bạn gpe! Mình có bảng số liệu, nhờ các bạn giúp mình chỉ lấy dữ liệu ở 2 vị trí đầu và vị trí cuối (bỏ vị trí giữa)
View attachment 112873 xin cảm ơn rất nhiều....

 

[thinh18tt]

Chào bạn;
Tôi đã tải về, mở ra xem nhưng thực sự không hiểu bạn muốn gì nữa. Bạn có thể mô tả rõ hơn được không?

 

[nad582]

Chào bạn;
Tôi đã tải về, mở ra xem nhưng thực sự không hiểu bạn muốn gì nữa. Bạn có thể mô tả rõ hơn được không?

Mình có dữ liệu ở sheet dulieu, mình muốn lấy dữ liệu ở vị trí đầu và vị trí cuối (ở cột C "ở cột Station" có 3 vị trí), bỏ vị trí ở giữa đi. ví dụ:
cột B có tên C1, cột C có 3 vị trí là 0,00 ; 2,20 và 4,40 giờ mình chỉ lấy dữ liệu ở vị trí đầu 0,00 và vị trí cuối là 4,40....kết quả thể hiện ở sheet ketqua....
cảm ơn nhiều...

 

[SA_DQ]

Dạo này có những bài na ná nhau thế nhỉ?

Bạn xem & kiểm trong file nha

Chúc vui vẻ!

 

[Quang_Hải]

Chào các bạn gpe! Mình có bảng số liệu, nhờ các bạn giúp mình chỉ lấy dữ liệu ở 2 vị trí đầu và vị trí cuối (bỏ vị trí giữa)
View attachment 112873 xin cảm ơn rất nhiều....

Kết quả cũng giống như bài 4, dù cách làm có hơi khác tí
Cho code này vào 1 module rồi chạy thử

Sub DauCuoi()
Dim Sarr(), Darr(), Dau, cuoi, KyHieu, DL, Dk
Dim I As Long, J As Long, X As Long, Y As Long
Set DL = Sheets("daulieu")
Sarr = DL.Range(DL.[a15], DL.[A65536].End(3).Offset(1)).Resize(, 11).Value
ReDim Darr(1 To UBound(Sarr), 1 To 11)
   KyHieu = GetUnique(Sarr)
   For Y = 0 To UBound(KyHieu)
      For I = 1 To UBound(Sarr)
         If Sarr(I, 1) & Sarr(I, 2) = KyHieu(Y) Then
            If Sarr(I, 3) < Dau Then Dau = Sarr(I, 3)
            If Sarr(I, 3) > cuoi Then cuoi = Sarr(I, 3)
         End If
      Next I
      For I = 1 To UBound(Sarr)
         If Sarr(I, 1) & Sarr(I, 2) = KyHieu(Y) Then
            If Sarr(I, 3) = Dau Or Sarr(I, 3) = cuoi Then
                  J = J + 1
                  For X = 1 To 11
                     Darr(J, X) = Sarr(I, X)
                  Next
            End If
         End If
      Next
      Dau = Empty: cuoi = Empty
   Next
   If J Then Sheets("ketqua").[L15].Resize(J, 11) = Darr
End Sub
Function GetUnique(Sarr())
Dim I As Long, Dk As String
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(Sarr)
      Dk = Sarr(I, 1) & Sarr(I, 2)
      If Not .exists(Dk) Then
         .Add Dk, ""
      End If
   Next
   GetUnique = .keys
End With
End Function