Nhờ tách dữ liệu trong các cột (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
P

pinklove

Thành viên thường trực
Tham gia
21/1/08
Bài viết
336
Được thích
42
Nhờ các anh chị em giúp đỡ viết code tách dữ liệu ở các cột theo như yêu cầu ở trong file kèm theo với ạ.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
pinklove đã viết:
Nhờ các anh chị em giúp đỡ viết code tách dữ liệu ở các cột theo như yêu cầu ở trong file kèm theo với ạ.
Nhấp chuột vào đây để mở rộng...

Trong lúc chờ cao thủ khác viết bằng Code mình xin làm thử bằng cách dùng CT, bạn thử xem có được không
 

File đính kèm

Upvote 0
pinklove đã viết:
Nhờ các anh chị em giúp đỡ viết code tách dữ liệu ở các cột theo như yêu cầu ở trong file kèm theo với ạ.
Nhấp chuột vào đây để mở rộng...
Kết quả G15=19/09/2015 là lấy từ đâu vậy?
Yêu cầu thế này thì "hổng có trách nhiệm" với bài viết của mình.
PHP: 
Public Sub CuLoi()
Dim sArr(), dArr(), I As Long
sArr = Range([A14], [A14].End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Mid(sArr(I, 1), InStr(sArr(I, 1), ":") + 1, Len(sArr(I, 1)))
    dArr(I, 2) = TimeSerial(Hour(sArr(I, 2)), Minute(sArr(I, 2)), Second(sArr(I, 2)))
    dArr(I, 3) = DateSerial(Year(sArr(I, 2)), Month(sArr(I, 2)), Day(sArr(I, 2)))
    If sArr(I, 3) <> Empty Then
        dArr(I, 4) = TimeSerial(Hour(sArr(I, 3)), Minute(sArr(I, 3)), Second(sArr(I, 3)))
        dArr(I, 5) = DateSerial(Year(sArr(I, 3)), Month(sArr(I, 3)), Day(sArr(I, 3)))
    End If
Next I
[E14].Resize(I - 1, 5) = dArr
End Sub
 

File đính kèm

  • CuLoi.jpg
    CuLoi.jpg
    37.6 KB · Đọc: 108
Upvote 0
pinklove đã viết:
Nhờ các anh chị em giúp đỡ viết code tách dữ liệu ở các cột theo như yêu cầu ở trong file kèm theo với ạ.
Nhấp chuột vào đây để mở rộng...

Bài này vừa dễ lại vừa khó:
- DỄ: chỉ là bài toán tách chuỗi, nhìn là thấy
- KHÓ: Vì cột B và C của bạn thuộc dạng Text nên khi tách ra rồi chuyển đổi thành ngày giờ có khả năng sẽ cho kết quả sai trên hệ thống mà Control Panel thiết lập M/d/yy

Gợi ý cho bạn công thức tại F14:
Mã: 
=IF(B14="",0,--RIGHT(B14,8))
Công thức tại G14:
Mã: 
=IF(B14="",0,DATE(MID(B14,7,4),MID(B14,4,2),LEFT(B14,2)))
Công thức tại H14:
Mã: 
=IF(C14="",0,--RIGHT(C14,8))
Công thức tại I14:
Mã: 
=IF(C14="",0,DATE(MID(C14,7,4),MID(C14,4,2),LEFT(C14,2)))
Tất cả kéo fill xuống
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Kết quả G15=19/09/2015 là lấy từ đâu vậy?
Yêu cầu thế này thì "hổng có trách nhiệm" với bài viết của mình.
PHP: 
Public Sub CuLoi()
Dim sArr(), dArr(), I As Long
sArr = Range([A14], [A14].End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Mid(sArr(I, 1), InStr(sArr(I, 1), ":") + 1, Len(sArr(I, 1)))
    dArr(I, 2) = TimeSerial(Hour(sArr(I, 2)), Minute(sArr(I, 2)), Second(sArr(I, 2)))
    dArr(I, 3) = DateSerial(Year(sArr(I, 2)), Month(sArr(I, 2)), Day(sArr(I, 2)))
    If sArr(I, 3) <> Empty Then
        dArr(I, 4) = TimeSerial(Hour(sArr(I, 3)), Minute(sArr(I, 3)), Second(sArr(I, 3)))
        dArr(I, 5) = DateSerial(Year(sArr(I, 3)), Month(sArr(I, 3)), Day(sArr(I, 3)))
    End If
Next I
[E14].Resize(I - 1, 5) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh. E xin lỗi vì cẩu thả trong việc làm ví dụ. Lần sau e sẽ cận thận hơn.
Ở chỗ tên NE phía sau vẫn còn cái dấu ")". Có bỏ nốt được không anh?
 
Upvote 0
bạn thay thành dArr(I, 1) = Mid(sArr(I, 1), InStr(sArr(I, 1), ":") + 1, Len(sArr(I, 1)) - InStr(sArr(I, 1), ":") - 1) là được mà
 
Upvote 0
Ba Tê đã viết:
Kết quả G15=19/09/2015 là lấy từ đâu vậy?
Yêu cầu thế này thì "hổng có trách nhiệm" với bài viết của mình.
PHP: 
Public Sub CuLoi()
Dim sArr(), dArr(), I As Long
sArr = Range([A14], [A14].End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Mid(sArr(I, 1), InStr(sArr(I, 1), ":") + 1, Len(sArr(I, 1)))
    dArr(I, 2) = TimeSerial(Hour(sArr(I, 2)), Minute(sArr(I, 2)), Second(sArr(I, 2)))
    dArr(I, 3) = DateSerial(Year(sArr(I, 2)), Month(sArr(I, 2)), Day(sArr(I, 2)))
    If sArr(I, 3) <> Empty Then
        dArr(I, 4) = TimeSerial(Hour(sArr(I, 3)), Minute(sArr(I, 3)), Second(sArr(I, 3)))
        dArr(I, 5) = DateSerial(Year(sArr(I, 3)), Month(sArr(I, 3)), Day(sArr(I, 3)))
    End If
Next I
[E14].Resize(I - 1, 5) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Giờ mới để ý cái chỗ đỏ đỏ này! "Bắt giò" anh Ba nha.
(liên quan đến M/d/yy trong Control Panel)
Ẹc... Ẹc...
 
Upvote 0
pinklove đã viết:
Mù mờ không hiểu chi hết anh ạ !$@!!
Em thử sửa lại định dạng là M/d/yy thì thấy vẫn đúng mà anh.
Nhấp chuột vào đây để mở rộng...

Sửa M/d/yy là sửa trong Control Panel ấy (không phải sửa trên bảng tính)
Sửa xong, chạy lại code sẽ biết liền
Một code chạy đúng là code luôn ra cùng một kết quả, bất kể Control Panel định dạng kiểu gì
 
Upvote 0
ndu96081631 đã viết:
Sửa M/d/yy là sửa trong Control Panel ấy (không phải sửa trên bảng tính)
Sửa xong, chạy lại code sẽ biết liền
Một code chạy đúng là code luôn ra cùng một kết quả, bất kể Control Panel định dạng kiểu gì
Nhấp chuột vào đây để mở rộng...
tôi rất quan tâm đến câu nói này của ndu96081631

. Anh có thể làm ví dụ chỉ giáo cho được không?
 
Upvote 0
Theo mình giờ theo english thì ngày trước tháng sau; giờ theo canada thì lại tháng trước ngày sau @@
 
Upvote 0
diemhuyenanh đã viết:
tôi rất quan tâm đến câu nói này của ndu96081631

. Anh có thể làm ví dụ chỉ giáo cho được không?
Nhấp chuột vào đây để mở rộng...
Ý a Ndu là khi chỉnh lại định dạng ngày trong control panel thành m/d/yy thì định dạng ở cột ngày tháng sau khi chạy code nó vẫn phải là mm/dd/yyyy thì đó mới là code đúng hoàn toàn. Anh Ndu cho e hỏi ngoài cách dùng công thức a đã gợi ý cho em thì nếu sửa lại code của bác Ba thì phải sửa thế nào cho đúng a.
 
Upvote 0
Ba Tê đã viết:
Kết quả G15=19/09/2015 là lấy từ đâu vậy?
Yêu cầu thế này thì "hổng có trách nhiệm" với bài viết của mình.
PHP: 
Public Sub CuLoi()
Dim sArr(), dArr(), I As Long
sArr = Range([A14], [A14].End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Mid(sArr(I, 1), InStr(sArr(I, 1), ":") + 1, Len(sArr(I, 1)))
    dArr(I, 2) = TimeSerial(Hour(sArr(I, 2)), Minute(sArr(I, 2)), Second(sArr(I, 2)))
    dArr(I, 3) = DateSerial(Year(sArr(I, 2)), Month(sArr(I, 2)), Day(sArr(I, 2)))
    If sArr(I, 3) <> Empty Then
        dArr(I, 4) = TimeSerial(Hour(sArr(I, 3)), Minute(sArr(I, 3)), Second(sArr(I, 3)))
        dArr(I, 5) = DateSerial(Year(sArr(I, 3)), Month(sArr(I, 3)), Day(sArr(I, 3)))
    End If
Next I
[E14].Resize(I - 1, 5) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
ANh Bate và các anh chị cho em hỏi thêm về đề tài này. Với code trên, bây giờ em muốn sau khi chuyển đổi thì sẽ có tiếp 2 cột tính tổng thời gian chạy theo giờ và theo phút dựa vào các cột vừa chuyển đổi. Ba Tê và các anh chị giúp đỡ.
(Em có làm bằng công thức nhưng bị lỗi nếu như giờ bắt đầu và giờ kết thúc ở 2 ngày khác nhau, tức là thời gian chạy máy quá 24h.)
 
Upvote 0
pinklove đã viết:
ANh Bate và các anh chị cho em hỏi thêm về đề tài này. Với code trên, bây giờ em muốn sau khi chuyển đổi thì sẽ có tiếp 2 cột tính tổng thời gian chạy theo giờ và theo phút dựa vào các cột vừa chuyển đổi. Ba Tê và các anh chị giúp đỡ.
(Em có làm bằng công thức nhưng bị lỗi nếu như giờ bắt đầu và giờ kết thúc ở 2 ngày khác nhau, tức là thời gian chạy máy quá 24h.)
Nhấp chuột vào đây để mở rộng...

Muốn trừ giờ thì bạn phải lấy Date2 + Timer2 - Date1 - Time1
Nếu chỉ lấy time trừ với time thì.. trật lất
 
Upvote 0
ndu96081631 đã viết:
Muốn trừ giờ thì bạn phải lấy Date2 + Timer2 - Date1 - Time1
Nếu chỉ lấy time trừ với time thì.. trật lất
Nhấp chuột vào đây để mở rộng...
Anh chỉ em công thức đi ạ. Em tìm hoài chẳng thấy.
Nếu có thể anh sửa luôn nơi code cho em được không ạ. Hôm hỏi code em quên mất. Giờ 12 tháng mỗi tháng hàng ngàn dòng công thức fill xuống thế này file hơi nặng ạ.
 
Upvote 0
pinklove đã viết:
Anh chỉ em công thức đi ạ. Em tìm hoài chẳng thấy.
Nếu có thể anh sửa luôn nơi code cho em được không ạ. Hôm hỏi code em quên mất. Giờ 12 tháng mỗi tháng hàng ngàn dòng công thức fill xuống thế này file hơi nặng ạ.
Nhấp chuột vào đây để mở rộng...

Hiện bạn đang dùng code gì tôi có biết đâu mà sửa. Đưa file đang có code đang dùng lên rồi tính
 
Upvote 0
ndu96081631 đã viết:
Hiện bạn đang dùng code gì tôi có biết đâu mà sửa. Đưa file đang có code đang dùng lên rồi tính
Nhấp chuột vào đây để mở rộng...
File của em là file Test. Còn file nguồn lấy dữ liệu là Repordata.
Dữ liệu Import vào từ cột B, ở cột G em muốn có tổng số giờ tính theo giờ, ở cột H tính theo phút.
Nhờ anh định dạng dữ liệu 2 cột này như ở mấy cột được import ra giúp em luôn.
 

File đính kèm

Upvote 0
pinklove đã viết:
File của em là file Test. Còn file nguồn lấy dữ liệu là Repordata.
Dữ liệu Import vào từ cột B, ở cột G em muốn có tổng số giờ tính theo giờ, ở cột H tính theo phút.
Nhờ anh định dạng dữ liệu 2 cột này như ở mấy cột được import ra giúp em luôn.
Nhấp chuột vào đây để mở rộng...

Thì vầy thôi:
Mã: 
Public Sub Exporting()
  Dim sArr(), dArr(), vFile
  Dim wkb As Workbook, wks As Worksheet, rng As Range
  Dim sFile As String, tmp As String
  Dim i As Long
  vFile = Application.GetOpenFilename("Excel Files, *.xls*")
  If TypeName(vFile) = "String" Then
    sFile = CStr(vFile)
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Open(sFile)
    Set wks = wkb.Worksheets("Sheet1")
    sArr = wks.Range("J14", wks.Range("E60000").End(xlUp)).Value
    wkb.Close False
    ReDim dArr(1 To UBound(sArr, 1), [COLOR=#0000cd]1 To 7[/COLOR])
    For i = 1 To UBound(sArr, 1)
      tmp = Mid(sArr(i, 1), InStr(sArr(i, 1), ":") + 1)
      dArr(i, 1) = Left(tmp, Len(tmp) - 5)
      dArr(i, 2) = TimeValue(Right(sArr(i, 5), 8))
      dArr(i, 3) = DateSerial(Mid(sArr(i, 5), 7, 4), Mid(sArr(i, 5), 4, 2), Left(sArr(i, 5), 2))
      If sArr(i, 3) <> Empty Then
        dArr(i, 4) = TimeValue(Right(sArr(i, 6), 8))
        dArr(i, 5) = DateSerial(Mid(sArr(i, 6), 7, 4), Mid(sArr(i, 6), 4, 2), Left(sArr(i, 6), 2))
      End If
      [COLOR=#ff0000]dArr(i, 6) = dArr(i, 5) + dArr(i, 4) - dArr(i, 3) - dArr(i, 2)
      dArr(i, 7) = Hour(dArr(i, 6)) * 60 + Minute(dArr(i, 6))[/COLOR]
    Next i
    Application.ScreenUpdating = True
    On Error Resume Next
    Set rng = Application.InputBox("Chon noi de dat", Type:=8)
    On Error GoTo 0
    If Not rng Is Nothing Then
      With rng.Resize(i - 1, 7)
        .Value = dArr
        .EntireColumn.AutoFit
        Union(.Offset(, 1).Resize(, 1), .Offset(, 3).Resize(, 1), .Offset(, 3).Resize(, 5)).NumberFormat = "hh:mm"
        Union(.Offset(, 2).Resize(, 1), .Offset(, 4).Resize(, 1)).NumberFormat = "dd/mm/yyyy"
        .Offset(, 6).Resize(, 1).NumberFormat = "General"
      End With
    End If
  End If
End Sub
Chỗ màu đỏ là thêm vào, màu xanh là sửa lại
Nhân tiện sửa luôn sub Xoa_DL cho gọn:
Mã: 
Sub Xoa_DL()
  Dim Ans As VbMsgBoxResult
  Ans = MsgBox("Ban chac chan muon xoa du lieu chu?", vbYesNo, "Xac nhan thong tin")
  If Ans = vbYes Then ActiveSheet.Range("B8:H60000").ClearContents
End Sub
---------------
Tôi thắc mắc: Đằng nào thì dữ liệu cũng sẽ được Import vào cột B, vậy tại sao bạn còn dùng cái Application.InputBox("Chon noi de dat", Type:=8) để làm gì?
 
Upvote 0
ndu96081631 đã viết:
Tôi thắc mắc: Đằng nào thì dữ liệu cũng sẽ được Import vào cột B, vậy tại sao bạn còn dùng cái Application.InputBox("Chon noi de dat", Type:=8) để làm gì?
Nhấp chuột vào đây để mở rộng...
Bởi vì thực tế có một số trạm bị hỏng cảnh báo, không có trong hệ thống thì trong tháng bọn em sẽ phải nhập liệu bằng thủ công. Vì vậy nên cuối tháng em inport số liệu vào sẽ chọn từ ô tiếp theo của cột B tiếp theo vị trí đã nhập, nếu không sẽ mất dữ liệu cũ.
 
Upvote 0
ndu96081631 đã viết:
Thì vầy thôi:
Mã: 
Public Sub Exporting()
  Dim sArr(), dArr(), vFile
  Dim wkb As Workbook, wks As Worksheet, rng As Range
  Dim sFile As String, tmp As String
  Dim i As Long
  vFile = Application.GetOpenFilename("Excel Files, *.xls*")
  If TypeName(vFile) = "String" Then
    sFile = CStr(vFile)
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Open(sFile)
    Set wks = wkb.Worksheets("Sheet1")
    sArr = wks.Range("J14", wks.Range("E60000").End(xlUp)).Value
    wkb.Close False
    ReDim dArr(1 To UBound(sArr, 1), [COLOR=#0000cd]1 To 7[/COLOR])
    For i = 1 To UBound(sArr, 1)
      tmp = Mid(sArr(i, 1), InStr(sArr(i, 1), ":") + 1)
      dArr(i, 1) = Left(tmp, Len(tmp) - 5)
      dArr(i, 2) = TimeValue(Right(sArr(i, 5), 8))
      dArr(i, 3) = DateSerial(Mid(sArr(i, 5), 7, 4), Mid(sArr(i, 5), 4, 2), Left(sArr(i, 5), 2))
      If sArr(i, 3) <> Empty Then
        dArr(i, 4) = TimeValue(Right(sArr(i, 6), 8))
        dArr(i, 5) = DateSerial(Mid(sArr(i, 6), 7, 4), Mid(sArr(i, 6), 4, 2), Left(sArr(i, 6), 2))
      End If
      [COLOR=#ff0000]dArr(i, 6) = dArr(i, 5) + dArr(i, 4) - dArr(i, 3) - dArr(i, 2)
      dArr(i, 7) = Hour(dArr(i, 6)) * 60 + Minute(dArr(i, 6))[/COLOR]
    Next i
    Application.ScreenUpdating = True
    On Error Resume Next
    Set rng = Application.InputBox("Chon noi de dat", Type:=8)
    On Error GoTo 0
    If Not rng Is Nothing Then
      With rng.Resize(i - 1, 7)
        .Value = dArr
        .EntireColumn.AutoFit
        Union(.Offset(, 1).Resize(, 1), .Offset(, 3).Resize(, 1), .Offset(, 3).Resize(, 5)).NumberFormat = "hh:mm"
        Union(.Offset(, 2).Resize(, 1), .Offset(, 4).Resize(, 1)).NumberFormat = "dd/mm/yyyy"
        .Offset(, 6).Resize(, 1).NumberFormat = "General"
      End With
    End If
  End If
End Sub
Nhấp chuột vào đây để mở rộng...

Vấn sai anh ạ. Ví dụ như trong hình em gửi, nếu em sửa lại file data để số giờ lớn hơn 24h thì nó sẽ ra kết quả sai.
Hơn nữa em muốn nhờ anh viết code riêng cho 2 cột G và H bởi vì để còn tính cho những dòng được nhập thủ công nữa.
 

File đính kèm

  • 1.JPG
    1.JPG
    104.8 KB · Đọc: 26
Upvote 0
pinklove đã viết:
Vấn sai anh ạ. Ví dụ như trong hình em gửi, nếu em sửa lại file data để số giờ lớn hơn 24h thì nó sẽ ra kết quả sai.
.
Nhấp chuột vào đây để mở rộng...

Yên tâm là không có sai đâu. Bởi cột G đang Format theo kiểu "hh:mm" nên thấy vậy thôi, nếu bạn format nó thành "[h]:mm" thì sẽ thấy ngay số giờ vượt quá 24
Riêng cột H, ta sửa thành vầy là chắc ăn nhất:
Mã: 
dArr(i, 7) = Int(dArr(i, 6) * 1440)
Toàn bộ code có thể sửa thành vầy:
Mã: 
Public Sub Exporting()
  Dim sArr(), dArr(), vFile
  Dim wkb As Workbook, wks As Worksheet, rng As Range
  Dim sFile As String, tmp As String
  Dim i As Long
  vFile = Application.GetOpenFilename("Excel Files, *.xls*")
  If TypeName(vFile) = "String" Then
    sFile = CStr(vFile)
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Open(sFile)
    Set wks = wkb.Worksheets("Sheet1")
    sArr = wks.Range("J14", wks.Range("E60000").End(xlUp)).Value
    wkb.Close False
    ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
    For i = 1 To UBound(sArr, 1)
      tmp = Mid(sArr(i, 1), InStr(sArr(i, 1), ":") + 1)
      dArr(i, 1) = Left(tmp, Len(tmp) - 5)
      dArr(i, 2) = TimeValue(Right(sArr(i, 5), 8))
      dArr(i, 3) = DateSerial(Mid(sArr(i, 5), 7, 4), Mid(sArr(i, 5), 4, 2), Left(sArr(i, 5), 2))
      If sArr(i, 3) <> Empty Then
        dArr(i, 4) = TimeValue(Right(sArr(i, 6), 8))
        dArr(i, 5) = DateSerial(Mid(sArr(i, 6), 7, 4), Mid(sArr(i, 6), 4, 2), Left(sArr(i, 6), 2))
      End If
      dArr(i, 6) = dArr(i, 5) + dArr(i, 4) - dArr(i, 3) - dArr(i, 2)
      [COLOR=#ff0000]dArr(i, 7) = Int(dArr(i, 6) * 1440)[/COLOR]
    Next i
    Application.ScreenUpdating = True
    On Error Resume Next
    Set rng = Application.InputBox("Chon noi de dat", Type:=8)
    On Error GoTo 0
    If Not rng Is Nothing Then
      With rng.Resize(i - 1, 7)
        .Value = dArr
        .EntireColumn.AutoFit
        Union(.Offset(, 1).Resize(, 1), .Offset(, 3).Resize(, 1)).NumberFormat = "hh:mm"
        Union(.Offset(, 2).Resize(, 1), .Offset(, 4).Resize(, 1)).NumberFormat = "dd/mm/yyyy"
        [COLOR=#ff0000].Offset(, 5).Resize(, 1).NumberFormat = "[hh]:mm"[/COLOR]
        .Offset(, 6).Resize(, 1).NumberFormat = "General"
      End With
    End If
  End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Yên tâm là không có sai đâu. Bởi cột G đang Format theo kiểu "hh:mm" nên thấy vậy thôi, nếu bạn format nó thành "[h]:mm" thì sẽ thấy ngay số giờ vượt quá 24
Riêng cột H, ta sửa thành vầy là chắc ăn nhất:
Mã: 
dArr(i, 7) = Int(dArr(i, 6) * 1440)
Toàn bộ code có thể sửa thành vầy:
Mã: 
Public Sub Exporting()
  Dim sArr(), dArr(), vFile
  Dim wkb As Workbook, wks As Worksheet, rng As Range
  Dim sFile As String, tmp As String
  Dim i As Long
  vFile = Application.GetOpenFilename("Excel Files, *.xls*")
  If TypeName(vFile) = "String" Then
    sFile = CStr(vFile)
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Open(sFile)
    Set wks = wkb.Worksheets("Sheet1")
    sArr = wks.Range("J14", wks.Range("E60000").End(xlUp)).Value
    wkb.Close False
    ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
    For i = 1 To UBound(sArr, 1)
      tmp = Mid(sArr(i, 1), InStr(sArr(i, 1), ":") + 1)
      dArr(i, 1) = Left(tmp, Len(tmp) - 5)
      dArr(i, 2) = TimeValue(Right(sArr(i, 5), 8))
      dArr(i, 3) = DateSerial(Mid(sArr(i, 5), 7, 4), Mid(sArr(i, 5), 4, 2), Left(sArr(i, 5), 2))
      If sArr(i, 3) <> Empty Then
        dArr(i, 4) = TimeValue(Right(sArr(i, 6), 8))
        dArr(i, 5) = DateSerial(Mid(sArr(i, 6), 7, 4), Mid(sArr(i, 6), 4, 2), Left(sArr(i, 6), 2))
      End If
      dArr(i, 6) = dArr(i, 5) + dArr(i, 4) - dArr(i, 3) - dArr(i, 2)
      [COLOR=#ff0000]dArr(i, 7) = Int(dArr(i, 6) * 1440)[/COLOR]
    Next i
    Application.ScreenUpdating = True
    On Error Resume Next
    Set rng = Application.InputBox("Chon noi de dat", Type:=8)
    On Error GoTo 0
    If Not rng Is Nothing Then
      With rng.Resize(i - 1, 7)
        .Value = dArr
        .EntireColumn.AutoFit
        Union(.Offset(, 1).Resize(, 1), .Offset(, 3).Resize(, 1)).NumberFormat = "hh:mm"
        Union(.Offset(, 2).Resize(, 1), .Offset(, 4).Resize(, 1)).NumberFormat = "dd/mm/yyyy"
        [COLOR=#ff0000].Offset(, 5).Resize(, 1).NumberFormat = "[hh]:mm"[/COLOR]
        .Offset(, 6).Resize(, 1).NumberFormat = "General"
      End With
    End If
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Chuẩn anh ạ. Nhưng anh có thể tách riêng cho em code cộng giờ (cột G) và phút (cột H) đó được ko ạ. Nếu để lồng trong code này luôn thì những dòng dữ liệu em nhập thủ công sẽ không ra được kết quả.
 
Upvote 0
pinklove đã viết:
Chuẩn anh ạ. Nhưng anh có thể tách riêng cho em code cộng giờ (cột G) và phút (cột H) đó được ko ạ. Nếu để lồng trong code này luôn thì những dòng dữ liệu em nhập thủ công sẽ không ra được kết quả.
Nhấp chuột vào đây để mở rộng...

Tách là tách sao? Không hiểu!
Sau khi Import dữ liệu vào các cột B đến cột F, giờ ta sẽ dựa vào dữ liệu ở 4 cột C, D, E và F để lấy ra giờ và phút cho G và H.. và code này ta viết riêng, đúng không?
Bạn tự suy nghĩ đi, có sẵn rồi còn gì
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Tách là tách sao? Không hiểu!
Sau khi Import dữ liệu vào các cột B đến cột F, giờ ta sẽ dựa vào dữ liệu ở 4 cột C, D, E và F để lấy ra giờ và phút cho G và H.. và code này ta viết riêng, đúng không?
Bạn tự suy nghĩ đi, có sẵn rồi còn gì
Nhấp chuột vào đây để mở rộng...
Nhưng như lúc nãy anh hỏi em vì sao luôn đặt dữ liệu ở cột B mà lại cần cái chọn nơi bắt đầu dán dữ liệu làm gì. Bởi dữ liệu import em làm vào cuối tháng, file data đó được Export từ phần mềm cảnh báo sự cố trạm của bọn em. Nhưng các ngày trong tháng em còn có một số dữ liệu phải nhập bằng thủ công do một số trạm không có cảnh báo nên bọn em không lấy data tự động được.
Vậy nên với code này chỉ có những dòng được import thì mới tính được giờ và phút còn những dòng dữ liệu nhập thủ công sẽ không có kết quả.
 
Upvote 0
pinklove đã viết:
Nhưng như lúc nãy anh hỏi em vì sao luôn đặt dữ liệu ở cột B mà lại cần cái chọn nơi bắt đầu dán dữ liệu làm gì. Bởi dữ liệu import em làm vào cuối tháng, file data đó được Export từ phần mềm cảnh báo sự cố trạm của bọn em. Nhưng các ngày trong tháng em còn có một số dữ liệu phải nhập bằng thủ công do một số trạm không có cảnh báo nên bọn em không lấy data tự động được.
Vậy nên với code này chỉ có những dòng được import thì mới tính được giờ và phút còn những dòng dữ liệu nhập thủ công sẽ không có kết quả.
Nhấp chuột vào đây để mở rộng...

Vậy thì trong file Test, bạn xài cái này cho cái nút IMPORT (Code của Ndu), khi chọn vị trí thì chọn ở cột A.
PHP: 
Public Sub Exporting()
  Dim sArr(), dArr(), vFile
  Dim wkb As Workbook, wks As Worksheet, rng As Range
  Dim sFile As String, tmp As String
  Dim I As Long
  vFile = Application.GetOpenFilename("Excel Files, *.xls*")
  If TypeName(vFile) = "String" Then
    sFile = CStr(vFile)
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Open(sFile)
    Set wks = wkb.Worksheets("Sheet1")
    sArr = wks.Range("J14", wks.Range("E60000").End(xlUp)).Value
    wkb.Close False
    ReDim dArr(1 To UBound(sArr, 1), 1 To 6)
    For I = 1 To UBound(sArr, 1)
      tmp = Mid(sArr(I, 1), InStr(sArr(I, 1), ":") + 1)
      dArr(I, 1) = I
      dArr(I, 2) = Left(tmp, Len(tmp) - 5)
      dArr(I, 3) = TimeValue(Right(sArr(I, 5), 8))
      dArr(I, 4) = DateSerial(Mid(sArr(I, 5), 7, 4), Mid(sArr(I, 5), 4, 2), Left(sArr(I, 5), 2))
      If sArr(I, 3) <> Empty Then
        dArr(I, 5) = TimeValue(Right(sArr(I, 6), 8))
        dArr(I, 6) = DateSerial(Mid(sArr(I, 6), 7, 4), Mid(sArr(I, 6), 4, 2), Left(sArr(I, 6), 2))
      End If
    Next I
    Application.ScreenUpdating = True
    On Error Resume Next
    Set rng = Application.InputBox("Chon noi de dat", Type:=8)
    On Error GoTo 0
    If Not rng Is Nothing Then
      With rng.Resize(I - 1, 6)
        .Value = dArr
        .EntireColumn.AutoFit
        Union(.Offset(, 2).Resize(, 1), .Offset(, 4).Resize(, 1)).NumberFormat = "hh:mm"
        Union(.Offset(, 3).Resize(, 1), .Offset(, 5).Resize(, 1)).NumberFormat = "dd/mm/yyyy"
      End With
    End If
  End If
  End Sub
Khi nào muốn có hoặc tính lại kết quả của cột G:H thì chạy Sub này (Gán vào cái nút nào đó)
Format trước cột G là [hh]:mm
PHP: 
Public Sub GPE_()
Dim sArr(), dArr(), I As Long, J As Long
sArr = Range([C8], [C65536].End(xlUp)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = sArr(I, 4) + sArr(I, 3) - sArr(I, 2) - sArr(I, 1)
    dArr(I, 2) = Int(dArr(I, 1) * 1440)
Next I
Range("G8:H8").Resize(I - 1) = dArr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Khi nào muốn có hoặc tính lại kết quả của cột G:H thì chạy Sub này (Gán vào cái nút nào đó)
Format trước cột G là [hh]:mm
PHP: 
Public Sub GPE_()
Dim sArr(), dArr(), I As Long, J As Long
sArr = Range([C8], [C65536].End(xlUp)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = sArr(I, 4) + sArr(I, 3) - sArr(I, 2) - sArr(I, 1)
    dArr(I, 2) = Int(dArr(I, 1) * 1440)
Next I
Range("G8:H8").Resize(I - 1) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Em đã làm được nhưng nếu như cột G8:H8 và format sai định dạng thì nó không ra kết quả đúng. Anh Ndu đã giải quyết giúp em bằng code
If Not rng Is Nothing Then
With rng.Resize(i - 1, 7)
.Value = dArr
.EntireColumn.AutoFit
Union(.Offset(, 1).Resize(, 1), .Offset(, 3).Resize(, 1)).NumberFormat = "hh:mm"
Union(.Offset(, 2).Resize(, 1), .Offset(, 4).Resize(, 1)).NumberFormat = "dd/mm/yyyy"
.Offset(, 5).Resize(, 1).NumberFormat = "[hh]:mm"
.Offset(, 6).Resize(, 1).NumberFormat = "General"
End With
End If
Nhấp chuột vào đây để mở rộng...
Nhưng chuyển sang code của anh em không biết cách.
Và em mong muốn gán code này vào một sự kiện của sheet như sheet_change chẳng hạn để nó tự chạy khi có sự thay đổi của các cột trước có được không?
 
Lần chỉnh sửa cuối:
Upvote 0
pinklove đã viết:
Em đã làm được nhưng nếu như cột G8:H8 và format sai định dạng thì nó không ra kết quả đúng. Anh Ndu đã giải quyết giúp em bằng code
Nhưng chuyển sang code của anh em không biết cách.
Và em mong muốn gán code này vào một sự kiện của sheet như sheet_change chẳng hạn để nó tự chạy khi có sự thay đổi của các cột trước có được không?
Nhấp chuột vào đây để mở rộng...

Định dạng kiểu gì thì làm thủ công 1 lân thôi mà. Mỗi lần chạy code đâu có xoá định dạng cột đâu mà ảnh hưởng sai. Tôi đã nói ở bài trên là:
Format trước cột G là [hh]:mm
Nhấp chuột vào đây để mở rộng...
Muốn mỗi lần chạy code là mỗi lần Format lại thì thêm vào code chỗ này:
PHP: 
Range("G8:H8").Resize(I - 1) = dArr
Range("G8").Resize(I - 1).NumberFormat = "[hh]:mm"
Muốn đưa vào sự kiện nào thì tuỳ bạn thôi. Thử đi rồi biết.
Mỗi lần thay đổi cột trước? Như bạn nói không phải chỉ là chạy code IMPORT mà còn nhập thủ công, mỗi lần nhập vào một ô nào đó là code chạy 1 lần? Nhập 100 ô code chạy 100 lần???????
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Muốn đưa vào sự kiện nào thì tuỳ bạn thôi. Thử đi rồi biết.
Mỗi lần thay đổi cột trước? Như bạn nói không phải chỉ là chạy code IMPORT mà còn nhập thủ công, mỗi lần nhập vào một ô nào đó là code chạy 1 lần? Nhập 100 ô code chạy 100 lần???????
Nhấp chuột vào đây để mở rộng...
Em làm thế này cho tất cả các tháng

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sArr(), dArr(), K As Long, J As Long
On Error Resume Next
If Left(UCase(Sh.Name), 5) = "THANG" Then
sArr = Range([C8], [C65536].End(xlUp)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
For K = 1 To UBound(sArr, 1)
dArr(K, 1) = sArr(K, 4) + sArr(K, 3) - sArr(K, 2) - sArr(K, 1)
dArr(K, 2) = Int(dArr(K, 1) * 1440)
Next K
Range("G8:H8").Resize(K - 1) = dArr
Range("G8").Resize(K - 1).NumberFormat = "[hh]:mm"
Range("H8").Resize(K - 1).NumberFormat = "General"
End If
End Sub
Nhấp chuột vào đây để mở rộng...

E thấy có ra đúng kết quả nhưng không biết có vấn đề gì không? nhờ anh tư vấn thêm
 
Upvote 0
pinklove đã viết:
Em làm thế này cho tất cả các tháng



E thấy có ra đúng kết quả nhưng không biết có vấn đề gì không? nhờ anh tư vấn thêm
Nhấp chuột vào đây để mở rộng...

Đã đọc hiểu code, đã vận dụng và sửa được code của người khác vào file thực của mình thì cứ thế mà "tiến tới".
Áp dụng vào chỗ nào thì thử hết vào các sự kiện, cái nào khoái thì xài.
Ai biết bạn muốn cái gì mà tư vấn.
 
Upvote 0
Ba Tê đã viết:
Đã đọc hiểu code, đã vận dụng và sửa được code của người khác vào file thực của mình thì cứ thế mà "tiến tới".
Áp dụng vào chỗ nào thì thử hết vào các sự kiện, cái nào khoái thì xài.
Ai biết bạn muốn cái gì mà tư vấn.
Nhấp chuột vào đây để mở rộng...
Nhờ anh kiểm tra giúp em. Với file em gửi kèm theo đây, Em có gán nó vào sự kiện Workbook_SheetChange kèm với code thay thế cho hàm Vlookup em lượm được của a Ndu và sửa lại thì khi em paste số liệu hoặc Import vào nó không tự tính được mà em phải tác động vào một trong các cột B,C,D,E,F thì code đó mới chạy trong khi Vlookup vẫn tốt, nhưng nếu em để nó đứng độc lập như code bài trên em đã sửa thì vẫn ok. Anh chỉ dùm em xem lý do vì sao và khắc phục thế nào ạ?
 

File đính kèm

Upvote 0
Anh Ndu, anh Ba Tê hay anh nào đó chỉ dùm em với ạ. Nghiền ngẫm cả chiều vẫn ko hiểu tại sao???
 
Upvote 0
pinklove đã viết:
Anh Ndu, anh Ba Tê hay anh nào đó chỉ dùm em với ạ. Nghiền ngẫm cả chiều vẫn ko hiểu tại sao???
Nhấp chuột vào đây để mở rộng...
Một kinh nghiệm khi hỏi bài là:
- Nên dự trù tất cả các tình huống và đưa ra một yêu cầu với 1 file mẫu, sao cho người khác giúp rồi thì không còn "ý quên, cho hỏi thêm, ví dụ tôi muốn ..., giả sử tôi muốn thêm..., bớt..." làm cho code đã viết phải "phá sản" làm lại từ đầu. Người viết code thành "công cốc".
- Đừng lấy code của người này đưa lên hỏi trên GPE nhờ thêm, bớt, hỏi sao "nó không chạy khi áp dụng vào file thực của tôi"... vì có thể không ai muốn chỉnh sửa code của người khác (đọc code là biết của ai trên GPE rồi).
- Đừng nêu đích danh người này, người kia giúp mình, người khác dù biết cũng chẳng thèm giúp, vì không liên quan tới mình.
- ....................
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Một kinh nghiệm khi hỏi bài là:
- Nên dự trù tất cả các tình huống và đưa ra một yêu cầu với 1 file mẫu, sao cho người khác giúp rồi thì không còn "ý quên, cho hỏi thêm, ví dụ tôi muốn ..., giả sử tôi muốn thêm..., bớt..." làm cho code đã viết phải "phá sản" làm lại từ đầu. Người viết code thành "công cốc".
- Đừng lấy code của người này đưa lên hỏi trên GPE nhờ thêm, bớt, hỏi sao "nó không chạy khi áp dụng vào file thực của tôi"... vì có thể không ai muốn chỉnh sửa code của người khác (đọc code là biết của ai trên GPE rồi).
- Đừng nêu đích danh người này, người kia giúp mình, người khác dù biết cũng chẳng thèm giúp, vì không liên quan tới mình.
- ....................
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh đã chỉ dẫn. Em sẽ rút kinh nghiệm cho những lần sau. Còn lần này chiếu cố giúp em đi ạ. Em thực sự muốn làm được nhưng cứ một mình mò mẫm khó quá, mà ở cái chỗ của em muốn học cũng ko có chỗ học. Tuổi đời thì cũng gần 4 chục rồi giờ mới bắt đầu đi mò cái này thấy não nó cứ chậm đi mấy nhịp. !$@!!!$@!!!$@!!!$@!!
 
Upvote 0
pinklove đã viết:
Cảm ơn anh đã chỉ dẫn. Em sẽ rút kinh nghiệm cho những lần sau. Còn lần này chiếu cố giúp em đi ạ. Em thực sự muốn làm được nhưng cứ một mình mò mẫm khó quá, mà ở cái chỗ của em muốn học cũng ko có chỗ học. Tuổi đời thì cũng gần 4 chục rồi giờ mới bắt đầu đi mò cái này thấy não nó cứ chậm đi mấy nhịp. !$@!!!$@!!!$@!!!$@!!
Nhấp chuột vào đây để mở rộng...

Gần 40 chưa phải là lớn tuổi (so với các thành viên GPE), tôi sắp về hưu nhưng vẫn có những "đại ca" huốt 60 rồi.
Như tôi đã viết ở bài trước, đừng quá tự động "làm phiền CPU". khi nào muốn thì bấm nút 1 phát thôi, mắc gì gán vào tự động mỗi lần "đụng đâu cũng chạy code".
File này là "tả pín lù" gồm code của ndu96081631 và của tôi, theo cách làm của tôi, 3 cái nút, tuỳ nghi sử dụng.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (2 người xem)
Trả lời
9
Đọc
436
Gà Con yêu VBA
Gà Con yêu VBA
Ả
Cách tạo list Data validation không qua trung gian (1 người xem)
Trả lời
46
Đọc
7K
thuytrangbp28
T
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ (1 người xem)
Trả lời
15
Đọc
2K
anhdepjai
A
T
[Giúp đỡ] Sửa lỗi runtime error 1004 application defined or object defined (2 người xem)
Trả lời
2
Đọc
97
tmhung0805
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
280
Đọc
35K
hoangtuan.net
hoangtuan.net
M
  • Question Question
[Hỏi cách tạo VBA] - Xin các cao nhân chỉ giúp cách tạo VBA cho công việc thuận tiện hơn
Trả lời
5
Đọc
222
SA_DQ
SA_DQ
dongbhhg
Hàm đếm số lượng trong khoảng thời gian cho trước (1 người xem)
Trả lời
6
Đọc
159
thanthanhan
thanthanhan
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (6 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
399
Đọc
47K
BlueSphere
B
N
Tạo file lưu trữ dữ liệu tự động trên excel.
Trả lời
12
Đọc
291
DeTong
D
D
  • Đã khóa
lọc các ô trong một cột chứa một nhóm dữ liệu? mong các cao thủ giải đáp giúp mình (1 người xem)
Trả lời
6
Đọc
170
ptm0412
ptm0412
S
cần xử lý dữ liệu trùng nhau bằng VBA
    • Cười
Trả lời
9
Đọc
264
HUONGHCKT
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
Trả lời
27
Đọc
25K
Anh2207
A
P
In file excel có cột bị gộp (1 người xem)
Trả lời
0
Đọc
64
ple28
P
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
8
Đọc
255
le_vis
L
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
569
ongke0711
ongke0711
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn (1 người xem)
Trả lời
3
Đọc
177
HieuCD
H
D
in ra bị thiếu chữ
Trả lời
4
Đọc
144
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
122
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN (1 người xem)
Trả lời
2
Đọc
107
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom