Lấy giá trị Calloff theo mã trạm

[quyenpv]

Em chào các anh chị.
Hàng ngày em hay phải tổng hợp dữ liêu Calloff thiết kế từ bộ phận thiết kế tối ưu để tính toán và cấp vật tư thiết bị, điều hành lắp đặt theo dữ liệu thiết kế đã đưa ra. Tuy nhiên nhập dữ liệu tay hay gây nhầm lẫn dẫn đến điều hành khắc phục rất khó khăn
Dữ liệu đầu vào theo thiết kế có thể 1 Cell, 2 Cell, 3 Cell tuỳ theo bộ phận thiết kế, có 1 số dữ liệu có thể dùng công thức để lấy được thông tin, còn phần Azimuth (°) + Tilt cơ (°) + Tilt điện (°) em không lấy được. Mong anh chị giúp đỡ
1. Dữ liệu ban đầu

2. Dữ liệu mong muốn

 

[HieuCD]

Em chào các anh chị.
Hàng ngày em hay phải tổng hợp dữ liêu Calloff thiết kế từ bộ phận thiết kế tối ưu để tính toán và cấp vật tư thiết bị, điều hành lắp đặt theo dữ liệu thiết kế đã đưa ra. Tuy nhiên nhập dữ liệu tay hay gây nhầm lẫn dẫn đến điều hành khắc phục rất khó khăn
Dữ liệu đầu vào theo thiết kế có thể 1 Cell, 2 Cell, 3 Cell tuỳ theo bộ phận thiết kế, có 1 số dữ liệu có thể dùng công thức để lấy được thông tin, còn phần Azimuth (°) + Tilt cơ (°) + Tilt điện (°) em không lấy được. Mong anh chị giúp đỡ
1. Dữ liệu ban đầu
View attachment 277462
2. Dữ liệu mong muốn
View attachment 277463

Dữ liệu xếp thứ tự code khá đơn giản

Sub ABC()
  Dim arr(), res(), sRow&, i&, k&, ma$
  With Sheets("Data")
    arr = .Range("B3", .Range("U" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  ReDim res(1 To sRow / 2, 1 To 7)
  For i = 1 To sRow
    If ma <> arr(i, 1) Then
      ma = arr(i, 1)
      k = k + 1
      res(k, 1) = ma
      res(k, 2) = arr(i, 6)
      res(k, 3) = arr(i, 20)
      res(k, 4) = arr(i, 9)
      res(k, 5) = arr(i, 10)
      res(k, 6) = arr(i, 11)
      res(k, 7) = arr(i, 12)
    Else
      res(k, 2) = arr(i, 6)
      res(k, 5) = res(k, 5) & "/" & arr(i, 10)
      res(k, 6) = res(k, 6) & "/" & arr(i, 11)
      res(k, 7) = res(k, 7) & "/" & arr(i, 12)
    End If
  Next i
  Sheets("DL Mong muon").Range("F2").Resize(k, 3).NumberFormat = "@"
  Sheets("DL Mong muon").Range("B2").Resize(k, 7) = res
End Sub

 

[quyenpv]

Dữ liệu xếp thứ tự code khá đơn giản

Sub ABC()
  Dim arr(), res(), sRow&, i&, k&, ma$
  With Sheets("Data")
    arr = .Range("B3", .Range("U" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  ReDim res(1 To sRow / 2, 1 To 7)
  For i = 1 To sRow
    If ma <> arr(i, 1) Then
      ma = arr(i, 1)
      k = k + 1
      res(k, 1) = ma
      res(k, 2) = arr(i, 6)
      res(k, 3) = arr(i, 20)
      res(k, 4) = arr(i, 9)
      res(k, 5) = arr(i, 10)
      res(k, 6) = arr(i, 11)
      res(k, 7) = arr(i, 12)
    Else
      res(k, 2) = arr(i, 6)
      res(k, 5) = res(k, 5) & "/" & arr(i, 10)
      res(k, 6) = res(k, 6) & "/" & arr(i, 11)
      res(k, 7) = res(k, 7) & "/" & arr(i, 12)
    End If
  Next i
  Sheets("DL Mong muon").Range("F2").Resize(k, 3).NumberFormat = "@"
  Sheets("DL Mong muon").Range("B2").Resize(k, 7) = res
End Sub

Dạ cám ơn anh!
Em mò mãi vẫn không viết được ạ