Ứng dụng EXCEL để lọc điểm trên bản vẽ Cad (5 người xem)

sanhdieu0911 · 15/1/14

siwtom đã viết:
Bạn không nên gửi tin nhắn.
Và khi nói với người không quen biết thì không nên dùng "tớ".
-----------
Bạn ạ, nếu bạn cần giúp thì cũng nên giải thích kỹ một chút. Bạn nghĩ là bạn cứ tung tập tin lên không một lời diễn giải rồi người ta sẽ nghiên cứu, đoán ý, rồi làm hộ bạn?
Dữ liệu của bạn có 5 cột với tiêu đề là: STT, x, y, H, code. Tôi hiểu x, y chẳng qua là tọa độ trong mặt phẳng Oxy của điểm tương ứng với mỗi dòng.

Trong "phần 1" tôi hiểu là trong mỗi "chu kỳ thao tác" sẽ phải:
1. Cho dòng 1 của "Bảng thao tác" (ở lúc "chào buổi sáng" là cả vùng dữ liệu) vào "Bảng thao tác" mới để dùng trong "chu kỳ thao tác" tiếp theo.
2. Duyệt từ dòng 2 tới cuối của bảng thao tác. Với mỗi dòng ta tính cự li giữa điểm hiện hành có tọa độ (xh, yh) và điểm (x1, y1), với (x1, y1) là tọa độ của điểm ứng với dòng 1.

Vì thế mới có

Mã:

S2= Căn bậc 2(( a 2 - a 1 )^2 + (b 2 - b 1 )^2) S3= Căn bậc 2(( a 3 - a 1 )^2 + (b 3 - b 1 )^2) S4= Căn bậc 2(( a 4 - a 1 )^2 + (b 4 - b 1 )^2) ...

với a là x, b là y

Bây giờ bạn muốn có

Mã:

S2= Căn bậc 2(( a 2 - a 1 )^2 + (b 2 - b 1 )^2 + (C 2 - C1)^2) S3= Căn bậc 2(( a 3 - a 1 )^2 + (b 3 - b 1 )^2 + (C 3 - C1)^2) S4= Căn bậc 2(( a 4 - a 1 )^2 + (b 4 - b 1 )^2 + (C 4 - C1)^2) ...

vậy tôi hiểu c là z.

Tức bây giờ ta tính cự li giữa 2 điểm trong không gian Oxyz.

Thế z, tức c, nó nằm ở cột nào vậy bạn? Nếu bạn muốn lấy các giá trị của cột có tiêu đề là H làm z thì bạn cũng phải nói một câu. Bạn muốn người khác đoán mò?

Muốn được giúp thì hãy làm cho người khác hiểu mình.

Mình không hiểu cách làm nên đôi khi nhờ các bạn mà viết chưa đúng... cám ơn bạn nhắc nhở, mình sẽ sửa thêm.

Trong bảng tính lần trước bạn làm giúp mình thì : X là cột B, y là cột C, Z là cột D.
Đây là đoạn code bạn đã viết giúp mình:
Sub DoSomething()
Dim Arr, tmp, index, result, count As Long, k As Long, e As Double, r As Long, c As Long, s As Double, startCell As Range
Arr = Range("$A$13:$E$25012").Value
e = [B1]
Set startCell = Range("G13")

ReDim index(1 To 1)
ReDim result(1 To UBound(Arr, 2), 1 To 1)

k = 0
Do
k = k + 1
ReDim Preserve result(1 To UBound(Arr, 2), 1 To k)
For r = 1 To UBound(Arr, 2)
result(r, k) = Arr(1, r)
Next r
count = 0
For r = 2 To UBound(Arr)
s = Sqr((Arr(1, 2) - Arr(r, 2)) ^ 2 + (Arr(1, 3) - Arr(r, 3)) ^ 2)
If s >= e Then
count = count + 1
ReDim Preserve index(1 To count)
index(count) = r
End If
Next r
If count > 0 Then
ReDim tmp(1 To count, 1 To UBound(Arr, 2))
For r = 1 To count
For c = 1 To UBound(Arr, 2)
tmp(r, c) = Arr(index(r), c)
Next c
Next r
Arr = tmp
End If
Loop Until count = 0

ReDim Arr(1 To k, 1 To UBound(result))
For r = 1 To k
For c = 1 To UBound(Arr, 2)
Arr(r, c) = result(c, r)
Next c
Next r

startCell.Resize(k, UBound(Arr, 2)).Value = Arr
End Sub

siwtom · 15/1/14

sanhdieu0911 đã viết:
Mình không hiểu cách làm nên đôi khi nhờ các bạn mà viết chưa đúng... cám ơn bạn nhắc nhở, mình sẽ sửa thêm.

Trong bảng tính lần trước bạn làm giúp mình thì : X là cột B, y là cột C, Z là cột D.

Nếu nói về lần trước thì chính xác là: x là cột B, y là cột C, H là cột D

Bây giờ nếu gửi tập tin lên thì bạn có 2 lựa chọn: hoặc trong tập tin sửa H thành z, hoặc nói một câu: z là cột D (H chính là z).

Bạn nên rút kinh nghiệm cho những lần hỏi sau
---------------
Tôi không test được vì dữ liệu chỉ ở dạng x = a1, y = b1, z = d1

Tất nhiên những chỗ xanh xanh phải sửa cho đúng vùng dữ liệu hiện hành

Mã:

Sub DoSomething()
Dim Arr, tmp, index, result, count As Long, k As Long, e As Double, r As Long, c As Long, s As Double, startCell As Range
'    "Bang thao tac" o thoi diem ban dau
    Arr = Range("[COLOR=#0000ff]$A$13:$E$32[/COLOR]").Value
    e = [[COLOR=#0000ff]B1[/COLOR]]
    Set startCell = Range("[COLOR=#0000ff]G13[/COLOR]")
    
    ReDim index(1 To 1)
    ReDim result(1 To UBound(Arr, 2), 1 To 1)
    
    k = 0
    Do
        k = k + 1
        ReDim Preserve result(1 To UBound(Arr, 2), 1 To k)
'        ghi dong dau cua Arr vao cot k cua result
        For r = 1 To UBound(Arr, 2)
            result(r, k) = Arr(1, r)
        Next r
        count = 0
'        duyet tu dong 2 cua Arr
        For r = 2 To UBound(Arr)
            s = Sqr((Arr(1, 2) - Arr(r, 2)) ^ 2 + (Arr(1, 3) - Arr(r, 3)) ^ 2 [B][COLOR=#ff0000]+ (Arr(1, 4) - Arr(r, 4)) ^ 2[/COLOR][/B])
            If s >= e Then
                count = count + 1
                ReDim Preserve index(1 To count)
'                nho chi so dong cua dong duoc them vao "Bang thao tac" dung cho chu ky sau
                index(count) = r
            End If
        Next r
        If count > 0 Then
'            tao Bang thao tac moi
            ReDim tmp(1 To count, 1 To UBound(Arr, 2))
            For r = 1 To count
                For c = 1 To UBound(Arr, 2)
                    tmp(r, c) = Arr(index(r), c)
                Next c
            Next r
'            Bang thao tac moi
            Arr = tmp
        End If
    Loop Until count = 0
    
    ReDim Arr(1 To k, 1 To UBound(result))
    For r = 1 To k
        For c = 1 To UBound(Arr, 2)
            Arr(r, c) = result(c, r)
        Next c
    Next r
    
    startCell.Resize(k, UBound(Arr, 2)).Value = Arr
End Sub

Chỗ đỏ đỏ là phần thêm duy nhất vào code cũ

sanhdieu0911 · 15/1/14

Cám ơn bạn siwtom rất nhiều!
Tôi sẽ cố gắng khắc phục và sửa chữa trong những lần tham gia sau...!

Ứng dụng EXCEL để lọc điểm trên bản vẽ Cad (5 người xem)

Người dùng đang xem chủ đề này

sanhdieu0911

Thành viên mới

siwtom

Thành viên gắn bó

sanhdieu0911

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian