Nhờ các bác giúp em cập nhập số liệu vào form HH có sẵn (1 người xem)

  • Thread starter Thread starter nilt02
  • Ngày gửi Ngày gửi
Liên hệ QC

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

nilt02

Thành viên hoạt động
Tham gia
19/3/08
Bài viết
119
Được thích
17
Giới tính
Nam
Trong file em đính kèm có sheet Formau em đã tính toán bằng tay chính xác, và sheet em Lamtay để các bác tiện theo dõi cách làm, nếu làm tay như vậy thì rất thủ công vì qua rất nhiều công đoạn...hoa mắt lắm các bác ạ, mà wellcode thì nhiều lắm !$@!!
Trong này cũng có sẵn VBA của bác sealand lần trước viết, chỉ cần chọn Wellcode thì sẽ tính toán ra bảng luôn nhưng em dốt nát khoản này nên chịu thua không áp dụng nó vào được. Các bác giúp em với ^^!
Rất cảm ơn các bác .
 

File đính kèm

Số liệu theo form của bạn thôi; Nếu muốn có từ đầu thì chờ nha

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [d2]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
   Dim MyAdd As String:                Const GX As String = "/"
   
   Set Sh = Sheets("Data"):            Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
   [d6].Resize(24, 10).ClearContents
   Set sRng = Rng.Find([d2].Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         For Each Cls In Range("D5:M5")
            
            If CStr(Year(sRng.Offset(, 1).Value)) & GX & sRng.Offset(, 2).Value = Cls.Value Then
               sRng.Offset(, 3).Resize(, 19).Copy
               Cls.Offset(1).PasteSpecial Transpose:=True
               Exit For
            Else
               
            End If
         Next Cls
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      MsgBox "Nothing!", , "GPE.COM Xin Luu Ý:"
   End If
 End If
End Sub
 

File đính kèm

Trong file em đính kèm có sheet Formau em đã tính toán bằng tay chính xác, và sheet em Lamtay để các bác tiện theo dõi cách làm, nếu làm tay như vậy thì rất thủ công vì qua rất nhiều công đoạn...hoa mắt lắm các bác ạ, mà wellcode thì nhiều lắm !$@!!
Trong này cũng có sẵn VBA của bác sealand lần trước viết, chỉ cần chọn Wellcode thì sẽ tính toán ra bảng luôn nhưng em dốt nát khoản này nên chịu thua không áp dụng nó vào được. Các bác giúp em với ^^!
Rất cảm ơn các bác .
Bài này nếu làm theo hướng sau kg biết có nhanh không
1/ Autofilter Cột A
2/ Filter theo "WellCode"
3/ Copy những cells hiện.
4/ Vào sh Form dán transpose (hàng thành cột và cột thành dòng)
5/ Xử lý lại form
Vấn đề bài này nếu muốn làm hiệu quả thì các dòng có WellCode, Date_Analyzing và Quarter phải là duy nhất, theo như topic trước bạn post và anh concogia đã làm code chắc là đã làm vấn đề trên rồi.
Giả dụ đã trích duy nhất rồi, để mình thử viết code theo hướng trên thử.
 
Và đây là lọc tất cả dữ liệu các năm mà bạn có

PHP:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [C1]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
   Dim MyAdd As String:                         Const GX As String = "/"
   Dim Jj As Byte
   
   Set Sh = Sheets("Data"):                     Jj = 3
   [d1].Resize(, 26).EntireColumn.Hidden = False
   Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
   [d5].Resize(24, 23).ClearContents
   Set sRng = Rng.Find([C1].Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      Application.ScreenUpdating = False:       MyAdd = sRng.Address
      Do
         Jj = Jj + 1:                           Set Cls = Cells(5, Jj)
         Cls.Value = CStr(Year(sRng.Offset(, 1).Value)) & GX & sRng.Offset(, 2).Value
         sRng.Offset(, 3).Resize(, 19).Copy
         Cls.Offset(1).PasteSpecial Transpose:=True
         
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      MsgBox "Nothing!", , "GPE.COM Xin Luu Ý:"
   End If
   Range(Cells(1, Jj + 1), [z1]).EntireColumn.Hidden = True
 End If
End Sub


Xem ở trang 'Form' (sửa lại từ trang 'LamTay' của bạn)
 

File đính kèm

Theo cách trên của bác ChanhTQ@ thì giữ nguyên được FromMau của em, cái này rất cần thiết để em copy paste ra Word, Excel... cho nhanh vì vài trăm bảng là bt ^^, nhưng phần tính TrungBinh, max, min bác và bạn HYen17 vẫn chưa hiểu ý em lắm. TrungBinh, max, min tính từ lúc có số liệu (ở đây thường là từ 2001-->2009). nếu tính từ 2005-->2009 thì cột tổng hợp của em bị ra sai kết quả.
Mong các bác và các bạn giúp em làm đúng FormMau với !^^!
Dưới đây là link Form HH từ lần trước, em cũng muốn nó xổ được list ở Wellcode ?
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=48354&d=1278411331
Thank all
 
Lần chỉnh sửa cuối:
(2) Theo cách giữ nguyên được FromMau của em, cái này rất cần thiết để em copy paste ra Word, Excel... cho nhanh vì vài trăm bảng là bt ^^, (1) nhưng phần tính TrungBinh, max, min bác và bạn HYen17 vẫn chưa hiểu ý em lắm. TrungBinh, max, min tính từ lúc có số liệu (ở đây thường là từ 2001-->2009). nếu tính từ 2005-->2009 thì cột tổng hợp của em bị ra sai kết quả.
Mong các bác và các bạn giúp em làm đúng FormMau với !^^!
(3) Dưới đây là link Form HH từ lần trước, em cũng muốn nó xổ được list ở Wellcode ?
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=48354&d=1278411331
Thank all
(1) Fần tổng hợp trong 3 cột từ 'AA' của mình đã thực hiện theo toàn bộ số liệu mà bạn có từ đầu; Bạn xem thử thỏa yêu cầu cho bạn chưa?

(2) Nếu bạn không cần hiện số liệu trước năm 2005 thì các cột trước cột này cho ẩn đi bạn chịu không?

(3) Muốn có DS (danh sách) sổ xuống để nhập liệu thì bạn cần tạo ra DS duy nhất theo cột WellCode đó & lập Validation. . . là được thôi. (Nên tham khảo trên diễn đàn để làm chuyện này)

Vài í cùng bạn & chờ thông tin từ bạn!
 
Mình không nhớ là Topic nào, thôi thì cứ gửi (Mình đã viết lại toàn bộ các hàm để dễ sử dụng hơn)
 

File đính kèm

(1) Fần tổng hợp trong 3 cột từ 'AA' của mình đã thực hiện theo toàn bộ số liệu mà bạn có từ đầu; Bạn xem thử thỏa yêu cầu cho bạn chưa?

(2) Nếu bạn không cần hiện số liệu trước năm 2005 thì các cột trước cột này cho ẩn đi bạn chịu không?

(3) Muốn có DS (danh sách) sổ xuống để nhập liệu thì bạn cần tạo ra DS duy nhất theo cột WellCode đó & lập Validation. . . là được thôi. (Nên tham khảo trên diễn đàn để làm chuyện này)

Vài í cùng bạn & chờ thông tin từ bạn!
Cảm ơn bạn có ý kiến chia sẻ, trong sheet bạn tạo Form cho mình, nếu bạn xắp sếp theo thứ tự năm thì mình mới ẩn đi được(ví dụ: |2005/K|2005/M|2006/K|2006/M|....), mình chỉ cần copy từ 2005-->2009 thôi mà, các cột khác ẩn đi cũng được, nhưng thứ tự xắp sếp giống FormMau nhé
Thank bạn nhiều :)
 
Mình không nhớ là Topic nào, thôi thì cứ gửi (Mình đã viết lại toàn bộ các hàm để dễ sử dụng hơn)
cảm ơn bác, em đã xem qua thấy đúng Form rồi bác ạ, nhưng kết quả phần tổng hợp thì vẫn chưa được như ý lắm. ví dụ:các dòng I, F, Phenol-->PO4 vẫn chưa đúng
Và nếu bác có thể để cho em dấu " - " vào cell trống thì tốt quá, nhiều số 0 quá em nhìn hoa cả mắt ^^
Thank bác!
 
Sửa lại macro bài trên là đạt; Bạn kiểm thừ xem sao, nha

trong sheet Form , nếu bạn xắp sếp theo thứ tự năm thì mình mới ẩn đi được(ví dụ: |2005/K|2005/M|2006/K|2006/M|....), mình chỉ cần copy từ 2005-->2009 thôi mà, các cột khác ẩn đi cũng được, nhưng thứ tự xắp sếp giống FormMau nhé

PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [C1]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
   Dim MyAdd As String, TDe As String, NamMùa As String
   Dim Jj As Byte, VTr As Byte, Cot As Byte:       Const GX As String = "/"
   
   Set Sh = Sheets("Data"):                        Jj = 13
   [d1].Resize(, 26).EntireColumn.Hidden = False
   Union([D6].Resize(24, 23), [N5].Resize(, 13)).ClearContents
   For Each Cls In Range("D5:M5")
      TDe = TDe & Cls.Value
   Next Cls
   Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
   Set sRng = Rng.Find([C1].Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      Application.ScreenUpdating = False:          MyAdd = sRng.Address
      Do
         NamMùa = CStr(Year(sRng.Offset(, 1).Value)) & GX & sRng.Offset(, 2).Value
         VTr = InStr(TDe, NamMùa)
         If VTr > 0 Then
            Cot = (VTr - 1) / 6 + 4
            sRng.Offset(, 3).Resize(, 19).Copy
            Cells(6, Cot).PasteSpecial Transpose:=True
         Else
            Jj = Jj + 1:                           Set Cls = Cells(5, Jj)
            Cls.Value = NamMùa
            sRng.Offset(, 3).Resize(, 19).Copy
            Cls.Offset(1).PasteSpecial Transpose:=True
         End If
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      MsgBox "Nothing!", , "GPE.COM Xin Luu Ý:"
   End If
   Range("N1:z1").EntireColumn.Hidden = True
 End If
End Sub
 

File đính kèm

Cảm ơn bác, em đang check, có vẻ như đúng rồi ạ :)
 
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [C1]) Is Nothing Then
   ...
End Sub
Em làm thử bài trên = array nhưng có một vấn đề là không hiểu tại sao
Đã tìm ra.
Code như sau nhưng code quá dài
PHP:
Option Explicit
Option Base 1
Dim endR As Long, iR As Long, iC As Long, fR As Long
Dim solan As Long, s As Long, i As Long, iNam As Long, iMua As Long
Dim wf As WorksheetFunction
Dim sWell As String, Tmp As String, sNamMua As String, myRng As Range
Dim Arr, ArrCT, ArrKQ, ArrMua(), ArrForm()
Sub TaoForm()
Set wf = WorksheetFunction
ArrMua = Array("K", "M")
With Sheets("FormMau")
  sWell = .[D2]
End With
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  Set myRng = .Range("A2:A" & endR)
End With
solan = wf.CountIf(myRng, sWell)
If solan = 0 Then GoTo bien
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  fR = wf.Match(sWell, myRng, 0)
  Set myRng = .Range("A2").Offset(fR - 1, 0).Resize(solan, 22)
  Arr = .Range("A2").Offset(fR - 1, 0).Resize(solan, 3).Value
  ArrCT = .Range("A2").Offset(fR - 1, 3).Resize(solan, 19).Value 'ct so lieu'
End With
ReDim ArrKQ(1 To 19, 1 To 21)
'cot thanh dong
For iC = 1 To UBound(ArrCT, 2) 'theo cot'
  solan = 0:  s = 0
  For iNam = 1 To 9
    For iMua = 1 To UBound(ArrMua)
      s = s + 1
      sNamMua = 2000 + iNam & "/" & ArrMua(iMua)
      For iR = 1 To UBound(Arr, 1) 'theo dong'
        Tmp = Year(Arr(iR, 2)) & "/" & Arr(iR, 3)
        If Tmp = sNamMua Then
          ArrKQ(iC, s) = ArrCT(iR, iC) 'gan cac tham so'
          
          If ArrKQ(iC, 20) < ArrCT(iR, iC) Then ArrKQ(iC, 20) = ArrCT(iR, iC) 'Max
          If ArrCT(iR, iC) = "" Then 'Min
            ArrKQ(iC, 21) = ArrKQ(iC, 21)
          ElseIf ArrKQ(iC, 21) = "" Or ArrKQ(iC, 21) > ArrCT(iR, iC) Then
            ArrKQ(iC, 21) = ArrCT(iR, iC)
          End If
          ArrKQ(iC, 19) = ArrKQ(iC, 19) + ArrKQ(iC, s) 'tong so
          If Len(ArrKQ(iC, s)) > 0 Then
            solan = solan + 1
          End If
          Exit For 'thoat vong lap iR vi chi xuat hien 1 lan sNamMua = Tmp'
        End If
      Next iR
    Next iMua
  Next iNam
  If solan = 0 Then
    ArrKQ(iC, 19) = 0
  Else
    ArrKQ(iC, 19) = ArrKQ(iC, 19) / solan
  End If
Next iC
'Tao lai Arr gan vao form, co the gan thang o tren
ReDim ArrForm(1 To 19, 1 To 13)
For iR = 1 To 19
  For iC = 9 To 21
    ArrForm(iR, iC - 8) = ArrKQ(iR, iC)
  Next iC
Next iR

With Sheets("FormMau").Range("D6").Resize(19, 13)
  .ClearContents
  .Value = ArrForm
End With
bien:
Erase Arr, ArrCT, ArrKQ, ArrMua(), ArrForm()
Set wf = Nothing: Set myRng = Nothing
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
PHP:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [C1]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
   Dim MyAdd As String:                         Const GX As String = "/"
   Dim Jj As Byte
   
   Set Sh = Sheets("Data"):                     Jj = 3
   [d1].Resize(, 26).EntireColumn.Hidden = False
   Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
   [d5].Resize(24, 23).ClearContents
   Set sRng = Rng.Find([C1].Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      Application.ScreenUpdating = False:       MyAdd = sRng.Address
      Do
         Jj = Jj + 1:                           Set Cls = Cells(5, Jj)
         Cls.Value = CStr(Year(sRng.Offset(, 1).Value)) & GX & sRng.Offset(, 2).Value
         sRng.Offset(, 3).Resize(, 19).Copy
         Cls.Offset(1).PasteSpecial Transpose:=True
         
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      MsgBox "Nothing!", , "GPE.COM Xin Luu Ý:"
   End If
   Range(Cells(1, Jj + 1), [z1]).EntireColumn.Hidden = True
 End If
End Sub
Xem ở trang 'Form' (sửa lại từ trang 'LamTay' của bạn)
Bạn HYen17 hoặc bạn nào có thể chỉnh cho mình cái Form này đc ko, link download bên dưới của bạn HYen17
Mình muốn delete row CN và Phenol, hiển thị tất cả các năm và xắp xếp theo thứ tự như sau: 2001/K|2001/M|2002/K|2002/M....|2009/K|2009/M|
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=52581&d=1285164509
Thank các bạn!
 
Bạn HYen17 hoặc bạn nào có thể chỉnh cho mình cái Form này đc ko, link download bên dưới của bạn HYen17
Mình muốn delete row CN và Phenol, hiển thị tất cả các năm và xắp xếp theo thứ tự như sau: 2001/K|2001/M|2002/K|2002/M....|2009/K|2009/M|
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=52581&d=1285164509
Thank các bạn!
Bạn xem file sau, thì thêm dòng code bỏ dòng 13 và 14.
 

File đính kèm

Bạn xem file sau, thì thêm dòng code bỏ dòng 13 và 14.
Cảm ơn bạn nhiều, trong FormMau bạn chỉ có từ 2005-->2009, bạn có thể cho cái bảng của mình nó hiện ra từ năm 2001-->2009 được không? vì bây giờ mình đang cần kiểm tra số liệu từ 2001 trở đi mà!
Thankkk!!
 
cảm ơn bác, em đã xem qua thấy đúng Form rồi bác ạ, nhưng kết quả phần tổng hợp thì vẫn chưa được như ý lắm. ví dụ:các dòng I, F, Phenol-->PO4 vẫn chưa đúng
Và nếu bác có thể để cho em dấu " - " vào cell trống thì tốt quá, nhiều số 0 quá em nhìn hoa cả mắt ^^
Thank bác!

Mặc dù bạn nói là đã có kết quả và bạn cho rằng phần tổng hợp của mình là chưa đúng, từ đây mình thấy cách tính của bạn hình như phải xem lại 1 chút phần tổng hợp. Mình cho rằng các chất vi lượng theo kết quả khảo sát từng mùa và năm có khác nhau nhưng không lẽ bằng 0 mà chỉ có thể có kỳ có số liệu và kỳ không có số liệu. Vậy thì bạn dùng hàm Average là không hợp lý và rất có thể dẫn đến sai sót.
Nếu dùng hàm Average =AVERAGE(B15:R15) nó tương đương =Sum(B15:R15)/CountA(B15:R15) . Điều này chỉ đúng khi các phần tử đều <>0.
Để kết quả đúng nó phải là =Sum(B15:R15)/Countif(B15:R15,">0"). Kỳ có kết quả= 0 dễ chừng là kỳ không khảo sát nên cũng không thể tham gia tính bình quân được
Vậy với Q.56 bạn thử tính bằng tay xem I có kết quả TB có thực sự là 3.20683

Còn con số hiển thị ra sao thì chỉ việc Format thôi mà
 
Lần chỉnh sửa cuối:
Cảm ơn bạn nhiều, trong FormMau bạn chỉ có từ 2005-->2009, bạn có thể cho cái bảng của mình nó hiện ra từ năm 2001-->2009 được không? vì bây giờ mình đang cần kiểm tra số liệu từ 2001 trở đi mà!
Thankkk!!
Thích thì chiều, bạn xem ở sh FormAll
 

File đính kèm

Mặc dù bạn nói là đã có kết quả và bạn cho rằng phần tổng hợp của mình là chưa đúng, từ đây mình thấy cách tính của bạn hình như phải xem lại 1 chút phần tổng hợp. Mình cho rằng các chất vi lượng theo kết quả khảo sát từng mùa và năm có khác nhau nhưng không lẽ bằng 0 mà chỉ có thể có kỳ có số liệu và kỳ không có số liệu. Vậy thì bạn dùng hàm Average là không hợp lý và rất có thể dẫn đến sai sót.
Nếu dùng hàm Average =AVERAGE(B15:R15) nó tương đương =Sum(B15:R15)/CountA(B15:R15) . Điều này chỉ đúng khi các phần tử đều <>0.
Để kết quả đúng nó phải là =Sum(B15:R15)/Countif(B15:R15,">0"). Kỳ có kết quả= 0 dễ chừng là kỳ không khảo sát nên cũng không thể tham gia tính bình quân được
Vậy với Q.56 bạn thử tính bằng tay xem I có kết quả TB có thực sự là 3.20683
Còn con số hiển thị ra sao thì chỉ việc Format thôi mà

Bác nói cũng đúng ạ, có năm bên em lấy, có năm lại ko, những cell nào có số "0" là coi như có phân tích, ô cell nào bỏ trống là không có gì cả

Thank bác nhiều lắm!
 
Web KT

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

Back
Top Bottom