Ứng dụng trong ngành Địa chính (1 người xem)

Liên hệ QC

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

Hoacomay96

Thành viên chính thức
Tham gia
18/3/08
Bài viết
96
Được thích
8
Xin chào tất cả anh chị tronh Diễn đàn.Em làm việc trong ngành địa chính em muốn nhờ các anh chị tạo code để tổng hợp số liệu địa chính từ file "Dulieu.xls".Tự động đếm được số tờ bản đồ và số mã loại đất trong file Dulieu.xls để kẻ thành bảng Tonghop và tổng hợp số liệu theo từng tờ bản đồ và từng loại đất.Em mới tìm hiểu VBA nên chưa làm được mong các Sư phụ chỉ giúp.Em có file kèm theo.Cảm ơn tất cả các anh chị.%#^#$
 

File đính kèm

Lần chỉnh sửa cuối:
Cái này bạn chỉ cần dùng hàm Sumif là ra rồi cần gì tới VBA
 

File đính kèm

Em muốn làm thành macro để tính tự động cho mọi người tiện sử dụng anh ạ (vì có người không thạo các hàm excel và các giá trị trong từng cột thay đổi theo từng xã nên mỗi lần tổng hợp các xã phải làm lại bảng tổng hợp(mà có rất nhiều xã càn tính). Mong các bậc tiền bối chỉ giúp, em cám ơn nhiều.
 
Bạn có thể sử dụng PivotTable để làm việc này
 
Vì nhiều người không thạo hàm này , và khối lượng phải tính nhiều nên em không dùng hàm PivotTable không tiện sử dụng nên em muốn làm Macro
 
Thì bạn cứ tự record lấy 1 macro quá trình tạo PivotTable là xong.. Khi ấy người dùng chỉ bấm 1 nhát là ra
ANH TUẤN
 
như thế chỉ áp dụng cho 1 file dữ liệu giống nhau, nếu dữ liệu thay đổi về số lượng biến thì không dùng được. anh chỉ cho em cách tìm số lượng giá trị không giống nhau (hặc giá trị lớn nhất) trong 1 cột dữ liệu và lần lượt ghi các giá trị đó vào bảng tính (viết bằng code VBA). Em xin cán ơn.
 
Hoacomay96 đã viết:
như thế chỉ áp dụng cho 1 file dữ liệu giống nhau, nếu dữ liệu thay đổi về số lượng biến thì không dùng được. anh chỉ cho em cách tìm số lượng giá trị không giống nhau (hặc giá trị lớn nhất) trong 1 cột dữ liệu và lần lượt ghi các giá trị đó vào bảng tính (viết bằng code VBA). Em xin cán ơn.
Sau lại ko dc chứ.. Tất nhiên record macro xong ta còn sửa lại chút ít.. chẳng hạn như khi chạy macro sẽ cho phép người dùng chọn vùng cần tổng hợp... Thế là đâu sợ gì dử liệu khác nhau chứ...
Còn số lượng và dử liệu biến thiên uh? Mổi lần muốn tổng hợp ta lại chạy macro là xong!
ANH TUẤN
 
Hoacomay96 đã viết:
Vì nhiều người không thạo hàm này , và khối lượng phải tính nhiều nên em không dùng hàm PivotTable không tiện sử dụng nên em muốn làm Macro
Cái này record macro, lập công thức cũng được, nhưng với số tên tờ bản đồ tăng, thêm loại đất, ... dẫn tới bảng tổng hợp tăng dòng, tăng cột. Do đó bảng tổng hợp là bảng động, số dòng, cột thay đổi theo dữ liệu thực tế.
Sub TongHop sẽ tạo bảng tổng hợp dựa vào số tên tờ bản đồ (lấy số tờ bản đồ lớn nhất để quyết định số dòng của bảng, lấy ô cuối của tên loại đất là cột cuối của bảng). Hoacomay96 chỉ việc khai báo tiêu đề của bảng tổng hợp với các tên loại đất chính xác và đầy đủ, bỏ trống từ F4 trở xuống. Các việc còn lại sub Tonghop làm.
Mã:
Sub TongHop()
Application.ScreenUpdating = False
On Error Resume Next
Dim MyRange As Range
Dim loai As String, sttloai As Byte, bando As Integer
Sheets("DATA").Select
rc = Cells(1, 1).End(xlDown).Row
cc = Cells(3, 9).End(xlToRight).Column
Range(Cells(4, 6), Cells(65536, cc)).Clear
Set MyRange = Range(Cells(3, 9), Cells(3, cc))
bandomax = Application.WorksheetFunction.Max(Range(Cells(2, 1), Cells(rc, 1)))
[COLOR=blue]' Đánh số tên tờ bản đồ[/COLOR]
For r = 1 To bandomax
  Cells(r + 3, 6) = r
Next
[COLOR=blue]'Lấy dữ liệu điền vào bảng[/COLOR]
For r = 2 To rc
  bando = Cells(r, 1)
  loai = Cells(r, 4)
  Cells(3 + bando, 7) = Cells(3 + bando, 7) + Cells(r, 3)
  Cells(3 + bando, 8) = Cells(3 + bando, 8) + Cells(r, 2)
  sttloai = Application.WorksheetFunction.Match(loai, MyRange, 0)
  If Err.Number > 0 Then
    MsgBox "Khong co loai dat " & loai
    Cells(r, 4).Select
    Exit Sub
  Else
    Cells(3 + bando, 8 + sttloai) = Cells(3 + bando, 8 + sttloai) + Cells(r, 3)
  End If
Next
[COLOR=blue]'Cộng dòng tổng[/COLOR]
For c = 7 To cc
  Cells(4 + bando, c) = Application.WorksheetFunction.Sum(Range(Cells(4, c), Cells(3 + bando, c)))
Next
[COLOR=blue]'Kẻ khung dịnh dạng bảng[/COLOR]
Set MyRange = Range(Cells(4, 6), Cells(4 + bandomax, cc))
MyRange.Borders(xlEdgeLeft).LineStyle = xlContinuous
MyRange.Borders(xlEdgeTop).LineStyle = xlContinuous
MyRange.Borders(xlEdgeBottom).LineStyle = xlContinuous
MyRange.Borders(xlEdgeRight).LineStyle = xlContinuous
MyRange.Borders(xlInsideVertical).LineStyle = xlContinuous
MyRange.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Cells(4 + bando, 6) = "T" & ChrW(7893) & "ng c" & ChrW(7843) & " xã"
Range(Cells(4 + bando, 6), Cells(4 + bando, cc)).Font.Bold = True
Cells(1, 1).Select
End Sub
 

File đính kèm

Em xin cảm ơn anh PHamDuyLong đã cho em cốt rất hay, đúng ý tưởng của em.Nhưng các kí hiệu ở cột Loại đất thay đổi theo từng xã, vậy ở bảng tổng hợp sẽ tự lấy mã loại đất ở cột Loại đất trong vùng dữ liệu, vậy số cột loại đất ở bảng Tổng hợp cũng thay đổi theo, và nó sẽ tự nhặt mã loại đất dán vào tổng hợp. Mong anh giúp em với, chờ tin anh.
 
Hoacomay96 đã viết:
Em xin cảm ơn anh PHamDuyLong đã cho em cốt rất hay, đúng ý tưởng của em.Nhưng các kí hiệu ở cột Loại đất thay đổi theo từng xã, vậy ở bảng tổng hợp sẽ tự lấy mã loại đất ở cột Loại đất trong vùng dữ liệu, vậy số cột loại đất ở bảng Tổng hợp cũng thay đổi theo, và nó sẽ tự nhặt mã loại đất dán vào tổng hợp. Mong anh giúp em với, chờ tin anh.
Trong sheet HuongDan có ghi : Phải khai báo đủ loại đất, nếu thiếu hoặc sai sẽ báo lỗi. Hoacomay96 chỉ phải tạo mẫu trước và phải kê khai đầy đủ loại đất vào các ô I2, J2, K3, ... cho đến loại đất tùy thực tế từng bảng xong mới chạy tổng kết. Dư thì được nhưng thiếu không tổng kết được.
 
Nhưng loại đất thay đổi theo từng file dữ liệu và có rất nhiều loại đất nên để tìm nó và lập đủ danh sách thì mất nhiều thời gian và có thể nhầm lẫn.Em muốn macro này tự đọc loại đất không trùng nhau trong từng file và nhặt ra bảng tổng hợp.Anh giúp em với.
 
Hoacomay96 đã viết:
Nhưng loại đất thay đổi theo từng file dữ liệu và có rất nhiều loại đất nên để tìm nó và lập đủ danh sách thì mất nhiều thời gian và có thể nhầm lẫn.Em muốn macro này tự đọc loại đất không trùng nhau trong từng file và nhặt ra bảng tổng hợp.Anh giúp em với.
Chỉnh lại Dulieu2 tự động tạo bảng tổng hợp cập nhật luôn loại đất.
 

File đính kèm

Chào anh Long, Em tải file Dulieu2 của anh về bị lỗi không mở được. a có thể port code lên diễn đàn cho em với.em cảm ơn nhiều.
 
Hoacomay96 đã viết:
Chào anh Long, Em tải file Dulieu2 của anh về bị lỗi không mở được. a có thể port code lên diễn đàn cho em với.em cảm ơn nhiều.
Mã:
Sub TongHop()
Application.ScreenUpdating = False
Dim MyRange As Range
Dim loai As String, sttloai As Byte, bando As Integer
Sheets("DATA").Select
Cells(1, 7).MergeCells = False
Columns("I:IV").MergeCells = False
rc = Cells(1, 1).End(xlDown).Row
bandomax = Application.WorksheetFunction.Max(Range(Cells(2, 1), Cells(rc, 1)))
Range(Cells(1, 4), Cells(rc, 4)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(2, 9), Unique:=True
r = 4: c = 10
Do While Cells(r, 9) <> ""
  Cells(3, c) = Cells(r, 9)
  c = c + 1
  r = r + 1
Loop
cc = c - 1
Range(Cells(4, 6), Cells(65536, 256)).Clear
Set MyRange = Range(Cells(3, 9), Cells(3, cc))
For r = 1 To bandomax
  Cells(r + 3, 6) = r
Next
For r = 2 To rc
  bando = Cells(r, 1)
  loai = Cells(r, 4)
  Cells(3 + bando, 7) = Cells(3 + bando, 7) + Cells(r, 3)
  Cells(3 + bando, 8) = Cells(3 + bando, 8) + Cells(r, 2)
  sttloai = Application.WorksheetFunction.Match(loai, MyRange, 0)
  If Err.Number > 0 Then
    MsgBox "Khong co loai dat " & loai
    Cells(r, 4).Select
    Err.Number = 0
    Exit Sub
  Else
    Cells(3 + bando, 8 + sttloai) = Cells(3 + bando, 8 + sttloai) + Cells(r, 3)
  End If
Next
'Tong hop
For c = 7 To cc
  Cells(4 + bando, c) = Application.WorksheetFunction.Sum(Range(Cells(4, c), Cells(3 + bando, c)))
Next
'Ke khung dinh dang
Set MyRange = Range(Cells(2, 6), Cells(4 + bandomax, cc))
MyRange.Borders(xlEdgeLeft).LineStyle = xlContinuous
MyRange.Borders(xlEdgeTop).LineStyle = xlContinuous
MyRange.Borders(xlEdgeBottom).LineStyle = xlContinuous
MyRange.Borders(xlEdgeRight).LineStyle = xlContinuous
MyRange.Borders(xlInsideVertical).LineStyle = xlContinuous
MyRange.Borders(xlInsideHorizontal).LineStyle = xlContinuous
MyRange.NumberFormat = "#,##0"
Cells(4 + bando, 6) = "T" & ChrW(7893) & "ng c" & ChrW(7843) & " xã"
Range(Cells(1, 6), Cells(3, cc)).Font.Bold = True
Range(Cells(4 + bando, 6), Cells(4 + bando, cc)).Font.Bold = True
Range(Cells(1, 7), Cells(1, cc)).MergeCells = True
Range(Cells(2, 9), Cells(2, cc)).MergeCells = True
Range(Cells(1, 7), Cells(3, cc)).HorizontalAlignment = xlCenter
Range(Cells(1, 7), Cells(2, cc)).EntireColumn.AutoFit
Cells(1, 1).Select
End Sub
Nếu không mở được, hoacomay96 mail cho tôi, tôi sẽ gởi cho.
 
Sửa code

Cảm ơn anh Long, em đã tải được rồi. Với code mới này thì có phải khai báo loại đất trước không anh hay nó tự động nhặt ra? anh cho em hỏi thêm nhé: sửa code thế nào để bảng Tổng hợp nằm riêng trên 1 file Tong.xls mới tạo ? và em muốn chèn thêm 1 cột nữa (cạnh cột Số thửa) vào bảng đó. giá trị mỗi ô cell ở cột đó = Tổng Diện tích tương ứng - giá trị 3 ô cell có loại đất là "XXX", "YYY", "ZZZ" (3 loại đất này lôn tồn tại ở dữ liệu). em làm mãi mà không được anh giúp em với nhé! (em có file kèm theo).
 

File đính kèm

Lần chỉnh sửa cuối:
Hoacomay96 đã viết:
Cảm ơn anh Long, em đã tải được rồi. Với code mới này thì có phải khai báo loại đất trước không anh hay nó tự động nhặt ra? anh cho em hỏi thêm nhé: sửa code thế nào để bảng Tổng hợp nằm riêng trên 1 file Tong.xls mới tạo ? và em muốn chèn thêm 1 cột nữa (cạnh cột Số thửa) vào bảng đó. giá trị mỗi ô cell ở cột đó = Tổng Diện tích tương ứng - giá trị 3 ô cell có loại đất là "XXX", "YYY", "ZZZ" (3 loại đất này lôn tồn tại ở dữ liệu). em làm mãi mà không được anh giúp em với nhé! (em có file kèm theo).
Dulieu2-2.xls tổng hợp tự động tên tờ bản đồ, tổng diện tích, số thửa, loại đất.
Riêng loại đất cần tổng hợp diện tích phụ phải khai báo vào sheet MauTH
Khai báo vào ô E3, F3, G3, ... cho đến hết loại đất cần tính diện tích phụ
Bấm chuột vào nút Tổng hợp trên sheet DATA, chương trình sẽ tổng hợp trên một workbook mới chưa đặt tên. Người dùng có thể lưu lại hoặc xóa bỏ tùy nhu cầu.
 

File đính kèm

cảm ơn anh Long đã tận tình giúp đỡ.Em muốn cột diện tích phụ này được tính đồng thời cùng với bảng Tổng, cùng trên 1 bảng tính. và cột diện tích phụ = diện tích tổng - XXX-YYY-ZZZ ( = cột dtích tổng trừ đi diện tích chỉ của 3 loại đất là XXX, YYY, ZZZ thôi, đã được xác định cụ thể). anh bớt thêm chút thời gian chỉnh lại giùm em nhé.
 
Web KT

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

Back
Top Bottom