Mình muốn biết 1 Giường nằm 1 ngày mấy người. Giúp mình với nha, đang rất cần. Cám ơn (5 người xem)

[tttu056]

Mình có ghi chú thích trong tập tin đính kèm. Thanks.

 

[Let'GâuGâu]

Mình có ghi chú thích trong tập tin đính kèm. Thanks.

ko biết tiêu đề của bạn có được xem là rỏ ràng ko!!!
bạn cho hỏi là bạn muốn tính số người trên một giường hay số ngày mà người đó nằm trên loại giường (1 ng,2ng,>3ng)?
kết quả ở ô V9 có thể hiểu như thế nào?
-có 5 ng nằm chung với ông hoàng trên cái giường 1 ng?
-hay số ngày ông hoàng năm trên giường 1ng là 5 ngày?
nếu là số ngày
vì sao ông hoàng và bà điều năm chung một giường mà ông hoàng 5 ngày mà bà điều 7 ngày?
vậy còn kết quả ông hoàng 7, bà điều 7 là gì vậy?

 

[tttu056]

mình có làm cái bảng bằng thủ công bạn nhìn vào sẽ hiểu rõ hơn, và những câu bạn hỏi mình cũng có trả lời trong file đính kèm luôn nha.
Mong bạn hiểu rõ vấn đề đề giúp mình.

 

[Let'GâuGâu]

mình có làm cái bảng bằng thủ công bạn nhìn vào sẽ hiểu rõ hơn, và những câu bạn hỏi mình cũng có trả lời trong file đính kèm luôn nha.
Mong bạn hiểu rõ vấn đề đề giúp mình.

ok, đã hiểu ý bạn
nhưng tôi nghĩ là hàm chắc là ko làm được, mà có làm được cũng ko chạy nổi.
để nguyên cứu xem, vba cũng ko nuốt chứ ko ko phải chơi

 

[Let'GâuGâu]

mình có làm cái bảng bằng thủ công bạn nhìn vào sẽ hiểu rõ hơn, và những câu bạn hỏi mình cũng có trả lời trong file đính kèm luôn nha.
Mong bạn hiểu rõ vấn đề đề giúp mình.

code này chạy tìm ra số ngày mà nằm một mình trên một giường, và 2 người trên một giường.............3 người trở lên chưa làm được..........hhiiihiihhii
để từ từ làm tiếp,
hóng cao thủ vào hổ trợ heheheheh

Sub tingngay()
Dim arr As Variant, i, j, k As Long
[L2:N60000].ClearContents
arr = [e2].Resize([e60000].End(3).Row - 1, 10).Value
For i = 1 To UBound(arr)
If IsEmpty(arr(i, 8)) And IsEmpty(arr(i, 9)) And IsEmpty(arr(i, 10)) Then
    For j = i + 1 To UBound(arr)

            If arr(j, 5) = arr(i, 5) And arr(j, 6) = arr(i, 6) Then
                If arr(j, 2) <= arr(i, 3) Then
                    arr(i, 8) = arr(j, 2) - arr(i, 2)
                    arr(i, 9) = arr(i, 3) - arr(j, 2)
                    arr(j, 8) = arr(i, 3) - arr(j, 2)
                    arr(j, 9) = arr(i, 3) - arr(j, 2)
                 End If
            End If

    Next j
End If
Next i
[e2].Resize([e60000].End(3).Row - 1, 10).Value = arr
End Sub

 

[Ba Tê]

mình có làm cái bảng bằng thủ công bạn nhìn vào sẽ hiểu rõ hơn, và những câu bạn hỏi mình cũng có trả lời trong file đính kèm luôn nha.
Mong bạn hiểu rõ vấn đề đề giúp mình.

Thử hàm tự tạo xem, kiểm tra lại thủ công đi, Nhìn rối quá, mà cũng không hiểu lắm

 

[tttu056]

cám ơn bạn rất nhiều, số liệu ra đúng đấy.
Nhưng bạn Ba tê cho mình hỏi xíu, sao mình làm ra bảng khác làm y xì bạn nhưng công thức

 

[Hau151978]

Mình có ghi chú thích trong tập tin đính kèm. Thanks.

Bạn insert thêm cột phụ H, nhập công thức H2=J2&"@"&K2, fill xuống.
Copy code này vào module rồi chạy, ra kết quả rồi thì xóa cột H đi. Trong bài của bạn chưa nói đến trường hợp bệnh nhân vào rồi ra trong cùng ngày nên mình bỏ qua không xét. Giới tính hình như chuẩn là nam=1, nữ=2 chứ không phải 0. Code dùng nhiều vòng lặp nên có thể chạy chậm, không biết có "đụng hàng" với các bác trả lời ở trên không?
Nhớ sao lưu file gốc trước khi chạy code.

Option Explicit
Sub abc()
    Dim dic As Object, a(), b(),c(), n&, i&, k, MinDate As Date, MaxDate As Date, d As Date
    Set dic = CreateObject("Scripting.Dictionary")
    n = Range("A" & Columns(1).Rows.Count).End(xlUp).Row
    ReDim a(1 To n - 1, 1 To 3)
    ReDim b(1 To n - 1)
    ReDim c(1 To n - 1, 1 To 3)
    a = Range("F2:H" & n).Value2
    MaxDate = Application.WorksheetFunction.Max(Range("G2:G" & n))
    MinDate = Application.WorksheetFunction.Min(Range("F2:F" & n))
    For i = 1 To n - 1
        If Not dic.exists(a(i, 3)) Then dic.Add a(i, 3), 0
    Next
    
    For d = MinDate To MaxDate
        For Each k In dic.keys
            dic.Item(k) = 0
        Next
        
        For i = 1 To n - 1
            If a(i, 1) <= d And a(i, 2) > d Then
                b(i) = True
                If dic.Item(a(i, 3)) < 3 Then dic.Item(a(i, 3)) = dic.Item(a(i, 3)) + 1
            Else
                b(i) = False
            End If
        Next
        
        For i = 1 To n - 1
            If b(i) Then
                c(i, dic.Item(a(i, 3))) = c(i, dic.Item(a(i, 3))) + 1
            End If
        Next
    Next
    Range("M2:O" & n) = c
    Set dic = Nothing
End Sub

 

[Ba Tê]

cám ơn bạn rất nhiều, số liệu ra đúng đấy.
Nhưng bạn Ba tê cho mình hỏi xíu, sao mình làm ra bảng khác làm y xì bạn nhưng công thức "songay" ko dùng được vậy.

Nếu không được nghĩa là "không y xì"
Hàm SoNgay() chỉ xài được trong file đó mà thôi.
Nếu muốn xài cho file khác thì phải copy cả cái Module và cái Function SoNgay() trong đó theo file.

Public Function SoNgay(Data As Range, Vao As Range, Ra As Range, Giuong As Range, Phong As Range, Optional DK As Long = 1) As Long
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Num As Long, Dic As Object, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Data.Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For J = Vao To Ra - 1
    Tem = J & "#" & Giuong & "#" & Phong
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = 0
    End If
Next J
For I = 1 To UBound(sArr, 1)
    For J = sArr(I, 1) To sArr(I, 2) - 1
        Tem = J & "#" & sArr(I, 4) & "#" & sArr(I, 5)
        If Dic.Exists(Tem) Then dArr(Dic.Item(Tem), 1) = dArr(Dic.Item(Tem), 1) + 1
    Next J
Next I
For I = 1 To K
    If DK < 3 Then
        If dArr(I, 1) = DK Then Num = Num + 1
    Else
        If dArr(I, 1) >= 3 Then Num = Num + 1
    End If
Next I
SoNgay = Num
Set Dic = Nothing
End Function

Chú ý lưu file kiểu .xls hoặc .xlsm, khi mở file nhớ Enable Macros.
Lưu kiểu .xlsx thì "tèo".
Công thức thì dù hàm tự tạo bằng VBA hay hàm Excel cũng làm "Rùa" file.
Xài Sub, bấm nút 1 phát cho nhanh, nhẹ, như file này

 

[tttu056]

Quá hay luôn. Ths bạn rất nhiều.
Cho mình xin số fone để khi nào mình cần thì nhờ bạn trợ giúp dùm mình chút được không.

 

[tttu056]

Cám ơn bạn nhiều nha, cho mình xin số fone có gì thì mình nhờ bạn trợ giúp được không.

 

[Let'GâuGâu]

Bạn insert thêm cột phụ H, nhập công thức H2=J2&"@"&K2, fill xuống.
Copy code này vào module rồi chạy, ra kết quả rồi thì xóa cột H đi. Trong bài của bạn chưa nói đến trường hợp bệnh nhân vào rồi ra trong cùng ngày nên mình bỏ qua không xét. Giới tính hình như chuẩn là nam=1, nữ=2 chứ không phải 0. Code dùng nhiều vòng lặp nên có thể chạy chậm, không biết có "đụng hàng" với các bác trả lời ở trên không?
Nhớ sao lưu file gốc trước khi chạy code.

tốc độ rất ấn tượng, nhưng hình như kết quả chưa đúng (ngay trường hợp 2 cái cell tô màu vàng)
ở chổ bạn hướng dẫn
H2=J2&"@"&K2
sao lại là k2?
cái này để làm gì?
ko thấy xài trong code?

 

[Hau151978]

tốc độ rất ấn tượng, nhưng hình như kết quả chưa đúng (ngay trường hợp 2 cái cell tô màu vàng)
ở chổ bạn hướng dẫn
H2=J2&"@"&K2
sao lại là k2?
cái này để làm gì?
ko thấy xài trong code?

Hai ô màu vàng đúng mà bác. Mình chèn thêm cột phụ H để lưu phòng+giường (phòng 22, giường 5 thành "22@5", các cột J và K bây giờ chứa phòng và giường) để đưa vào DIC. Mục đích để nạp 3 cột dữ liệu F (ngày vào), G (ngày ra), H (phòng@giường) vào array cho đỡ tốn bộ nhớ.
Bác tìm được 1 người/giường, 2 người/giường rồi thì >=3 người/giường thì chỉ cần lấy tổng số ngày trừ đi là xong mà?

 

[Let'GâuGâu]

Hai ô màu vàng đúng mà bác. Mình chèn thêm cột phụ H để lưu phòng+giường (phòng 22, giường 5 thành "22@5", các cột J và K bây giờ chứa phòng và giường) để đưa vào DIC. Mục đích để nạp 3 cột dữ liệu F (ngày vào), G (ngày ra), H (phòng@giường) vào array cho đỡ tốn bộ nhớ.
Bác tìm được 1 người/giường, 2 người/giường rồi thì >=3 người/giường thì chỉ cần lấy tổng số ngày trừ đi là xong mà?

ok, rất hay
nhưng sao bạn ko cho cột phụ đó vào cột cuối (cột L)
nói chung là dùng code thao tác hết, xong code xóa nó luôn
tự động hóa hết
cám ơn, giải thuật rất hay

 

[Hau151978]

nhưng sao bạn ko cho cột phụ đó vào cột cuối (cột L)
nói chung là dùng code thao tác hết, xong code xóa nó luôn
tự động hóa hết

Mục đích mình nạp 3 cột F:H vào mảng cho tiện, nếu đưa cột phụ vào cột L thì phải nạp vào mảng các cột F:L trong khi có các cột không cần thiết, sẽ tốn bộ nhớ.
Còn code chèn cột, xóa cột mình ngại viết nên làm bằng tay!

 

[Let'GâuGâu]

Mục đích mình nạp 3 cột F:H vào mảng cho tiện, nếu đưa cột phụ vào cột L thì phải nạp vào mảng các cột F:L trong khi có các cột không cần thiết, sẽ tốn bộ nhớ.
Còn code chèn cột, xóa cột mình ngại viết nên làm bằng tay!

bạn có chắc là nó tốn bộ nhớ ko?
tôi ko chắc lắm, nhưng hình như nó là bộ nhớ ảo mà? đâu có chiếm bộ nhớ?
tôi thêm một vòng lặp vào code của bạn, thấy nó cũng chạy ổn

Sub abc()
    Dim dic As Object, a(), b(), c(), n&, i&, k, MinDate As Date, MaxDate As Date, d As Date
    Set dic = CreateObject("Scripting.Dictionary")
    [L2:N60000].ClearContents
    n = [a60000].End(3).Row
    ReDim a(1 To n - 1, 1 To 5)
    ReDim b(1 To n - 1)
    ReDim c(1 To n - 1, 1 To 3)
    a = [F2].Resize(n - 1, 5).Value
    MaxDate = Application.WorksheetFunction.Max(Range("G2:G" & n))
    MinDate = Application.WorksheetFunction.Min(Range("F2:F" & n))
    For i = 1 To UBound(a)
        a(i, 3) = a(i, 4) & "@" & a(i, 5)
        'If a(i, 1) > MaxDate Then MaxDate = a(i, 1)
        'If a(i, 2) < MinDate Then MinDate = a(i, 2)
    Next
    For i = 1 To n - 1
        If Not dic.exists(a(i, 3)) Then dic.Add a(i, 3), 0
    Next
    
    For d = MinDate To MaxDate
        For Each k In dic.keys
            dic.Item(k) = 0
        Next
        
        For i = 1 To n - 1
            If a(i, 1) <= d And a(i, 2) > d Then
                b(i) = True
                If dic.Item(a(i, 3)) < 3 Then dic.Item(a(i, 3)) = dic.Item(a(i, 3)) + 1
            Else
                b(i) = False
            End If
        Next
        
        For i = 1 To n - 1
            If b(i) Then
                c(i, dic.Item(a(i, 3))) = c(i, dic.Item(a(i, 3))) + 1
            End If
        Next
    Next
    [L2].Resize(n - 1, 3) = c
    Set dic = Nothing
End Sub