Nhờ Trợ giúp ghi lại các giá trị trong bài toán có điều kiện

TuPham86

Thành viên mới
Tham gia ngày
28 Tháng mười một 2019
Bài viết
12
Được thích
0
Điểm
13
Tuổi
34
Em chào các bác. em có một bài toán muốn nhờ các bác trợ giúp ghi lại các giá trị ra một mảng, của một bài toán có điều kiên. Em có 2 cọc số thứ tự STT1 và STT2 trong 2 cột có ghi số thứ tự 2.3.5.6.7 và cột giá trị 20.30.40.50.60.70 tương ứng, cột 2 thí có giá trị lớp 1.5.7.8.10 và cột giá trị bên cạnh 21.31.41.51.61.71. Bài toán của em là e muốn ghi ra giá trị để lấy tọa độ điểm, Đường số 1 giá trị 20 và 31
Đường số 2 30 và 31.......Số cột thứ tự nó có thể đổi như trường hợp 2 ạ, nhưng nó sẽ là từ bé đến lớn ạ. Mục đích của em là lấy tọa độ 2 điểm để vẽ đường đường thẳng(vi du 30 và 31...)để vẽ đường số 1...số 2....Như hình vẽ e mô tả, do em chưa biết logic lại điều kiện, xắp sếp và so sánh. nên nhờ sự trợ giúp ạ. File e có để đính kèm ở dưới ạ. em xin chân thành cảm ơn các bác ạ..ve duong line.png
 

File đính kèm

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
7,237
Được thích
14,261
Điểm
1,860
Em chào các bác. em có một bài toán muốn nhờ các bác trợ giúp ghi lại các giá trị ra một mảng, của một bài toán có điều kiên. Em có 2 cọc số thứ tự STT1 và STT2 trong 2 cột có ghi số thứ tự 2.3.5.6.7 và cột giá trị 20.30.40.50.60.70 tương ứng, cột 2 thí có giá trị lớp 1.5.7.8.10 và cột giá trị bên cạnh 21.31.41.51.61.71. Bài toán của em là e muốn ghi ra giá trị để lấy tọa độ điểm, Đường số 1 giá trị 20 và 31
Đường số 2 30 và 31.......Số cột thứ tự nó có thể đổi như trường hợp 2 ạ, nhưng nó sẽ là từ bé đến lớn ạ. Mục đích của em là lấy tọa độ 2 điểm để vẽ đường đường thẳng(vi du 30 và 31...)để vẽ đường số 1...số 2....Như hình vẽ e mô tả, do em chưa biết logic lại điều kiện, xắp sếp và so sánh. nên nhờ sự trợ giúp ạ. File e có để đính kèm ở dưới ạ. em xin chân thành cảm ơn các bác ạ..View attachment 245586
Dữ liệu cột B:E
Mã:
Sub XYZ()
  Dim sArr(), sArr2(), Arr(), Res()
  Dim iMin&, iMax&, i&, i2&, k&, tmp, tmp2
 
  i = Range("C" & Rows.Count).End(xlUp).Row
  sArr = Range("B2:C" & i).Value
  i2 = Range("E" & Rows.Count).End(xlUp).Row
  sArr2 = Range("D2:E" & i2).Value
  iMin = Application.Min(Range("B3:B" & i), Range("E3:E" & i2))
  iMax = Application.Max(Range("B3:B" & i), Range("E3:E" & i2))
  If sArr(2, 1) = iMin Then sArr2(1, 2) = iMin Else sArr(1, 1) = iMin
 
  ReDim Arr(iMin To iMax, 1 To 2)
  ReDim Res(1 To 1000, 1 To 3)
  On Error Resume Next
  For i = 1 To UBound(sArr)
    Arr(sArr(i, 1), 1) = sArr(i, 2)
  Next i
  For i = 1 To UBound(sArr2)
    Arr(sArr2(i, 2), 2) = sArr2(i, 1)
  Next i
  For i = iMin To iMax
    If Arr(i, 1) <> Empty Then tmp = Arr(i, 1)
    If Arr(i, 2) <> Empty Then tmp2 = Arr(i, 2)
    If Arr(i, 1) <> Empty Or Arr(i, 2) <> Empty Then
      k = k + 1
      Res(k, 1) = "Duong So " & k
      Res(k, 2) = tmp
      Res(k, 3) = tmp2
    End If
  Next i
  Range("F3:H1000").ClearContents
  Range("F3").Resize(k, 3) = Res
End Sub
 

File đính kèm

TuPham86

Thành viên mới
Tham gia ngày
28 Tháng mười một 2019
Bài viết
12
Được thích
0
Điểm
13
Tuổi
34
Em cảm ơn bác @HieuCD rất nhiều, Code đúng ý của em rồi ạ. Chúc bác ngày mới vui vẻ.
 
Top Bottom