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 (2 người xem)
- Thread starter tttu056
- Ngày gửi
Người dùng đang xem chủ đề này
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
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?
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
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
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
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
Mã:
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ê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
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
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.
Mã:
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
Lần chỉnh sửa cuối:
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
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.
PHP:
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 FunctionLư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
Lần chỉnh sửa cuối:
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
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?
Lần chỉnh sửa cuối:
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à?
Lần chỉnh sửa cuối:
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
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
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
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
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
Mã:
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
Lần chỉnh sửa cuối:
Bài viết mới nhất
- Question
- Question
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
(1 người xem)
- Question
- Question
- Question
- Question
