Lấy giá trị ngày tháng bằng vba thay hàm index trong excel (2 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)
T

thufpts

Thành viên hoạt động
Tham gia
6/8/12
Bài viết
157
Được thích
6
Giới tính
Nam
Nghề nghiệp
Bốc vác
Chào các bác. em có một vấn đề này xin đệ trình với các bác. em có một dòng là ngày tháng là dòng thứ 5 từ Q5 đến AF5
1)khi em nhập một số bất kỳ ví dụ nhập 2 48 10 nó sẽ tự động lấy các ngày tương ứng là 7-Now, 7-Now, 7 Now từ dòng thứ 5 để trả về cột N đối xứng với các số đã nhập.
2) chỉ tính đối với ô đâu tiên được nhập sẽ lấy được giá trị ngày tháng còn ô đứng sau nếu có giá trị sẽ bỏ qua.
ví dụ em nhập 22 vào R9 thì ngày 8-Now sẽ được trả về N9 còn giá trị 14 đứng sau 22 sẽ ko lấy dc ngày tháng.
Với khả năng của em thì em chỉ có thể dùng hàm mặc định trong excel là index(). nhưng bản thân em viết ra được nhưng đến khi có lỗi em ko sửa được vì dối mắt lắm.
kính mong các bác giúp em.

Capture.jpg
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thufpts đã viết:
Chào các bác. em có một vấn đề này xin đệ trình với các bác. em có một dòng là ngày tháng là dòng thứ 5 từ Q5 đến AF5
1)khi em nhập một số bất kỳ ví dụ nhập 2 48 10 nó sẽ tự động lấy các ngày tương ứng là 7-Now, 7-Now, 7 Now từ dòng thứ 5 để trả về cột N đối xứng với các số đã nhập.
2) chỉ tính đối với ô đâu tiên được nhập sẽ lấy được giá trị ngày tháng còn ô đứng sau nếu có giá trị sẽ bỏ qua.
ví dụ em nhập 22 vào R9 thì ngày 8-Now sẽ được trả về N9 còn giá trị 14 đứng sau 22 sẽ ko lấy dc ngày tháng.
Với khả năng của em thì em chỉ có thể dùng hàm mặc định trong excel là index(). nhưng bản thân em viết ra được nhưng đến khi có lỗi em ko sửa được vì dối mắt lắm.
kính mong các bác giúp em.
Nhấp chuột vào đây để mở rộng...
làm cho bạn cả 3 cách
1/ dùng hàm Excel
2/ Dùng hàm tự tạo
2 cách trên bạn theo công thức trong file, đặt cột nào cũng được
3/ bấm vào biểu tượng chạy code
 

File đính kèm

Upvote 0
HieuCD đã viết:
làm cho bạn cả 3 cách
1/ dùng hàm Excel
2/ Dùng hàm tự tạo
2 cách trên bạn theo công thức trong file, đặt cột nào cũng được
3/ bấm vào biểu tượng chạy code
Nhấp chuột vào đây để mở rộng...
bác có thể làm cho nó auto lấy ngày khi có giá trị mà ko cần nhấn click vào biểu tưởng được không bác.
 
Upvote 0
Ba Tê đã viết:
Nếu bạn muốn "tự động" thì xem file này:
Nhấp chuột vào đây để mở rộng...

Nó chạy được bác ạ nhưng nếu copy ra nhiều sheet thì code sẽ bị trùng. nghĩa là mỗi sheet bắt buộc phải chưa code đó.
mỗi khi em copy 1 ô ra nhiều ô nó không tự update mà phải nhập từng ô nó mới chạy bác ạ.
có các nào để có nhiều sheet mà vẫn dùng một code.
ý em là tạo code trong module còn sheet nào muốn dùng chỉ việc gọi sub đó ra được không bác
 
Upvote 0
thufpts đã viết:
Nó chạy được bác ạ nhưng nếu copy ra nhiều sheet thì code sẽ bị trùng. nghĩa là mỗi sheet bắt buộc phải chưa code đó.
mỗi khi em copy 1 ô ra nhiều ô nó không tự update mà phải nhập từng ô nó mới chạy bác ạ.
có các nào để có nhiều sheet mà vẫn dùng một code.
ý em là tạo code trong module còn sheet nào muốn dùng chỉ việc gọi sub đó ra được không bác
Nhấp chuột vào đây để mở rộng...
mỗi khi em copy 1 ô ra nhiều ô nó không tự update mà phải nhập từng ô nó mới chạy bác ạ.
Nhấp chuột vào đây để mở rộng...
Vì bạn viết
1)khi em nhập một số bất kỳ ví dụ nhập 2 48 10 nó sẽ tự động lấy các...
Nhấp chuột vào đây để mở rộng...
Nên Thầy Ba Tê giới hạn mỗi lần nhập 1 cell
nhưng nếu copy ra nhiều sheet thì code sẽ bị trùng. nghĩa là mỗi sheet bắt buộc phải chưa code đó.
Nhấp chuột vào đây để mở rộng...
Copy ra nhiều Sheet thì phải giống nhau về địa chỉ rồi chép code vào sự kiện Workbook_SheetChange thì chỉ cần 1 code
Thân
 
Upvote 0
concogia đã viết:
Vì bạn viết

Nên Thầy Ba Tê giới hạn mỗi lần nhập 1 cell

Copy ra nhiều Sheet thì phải giống nhau về địa chỉ rồi chép code vào sự kiện Workbook_SheetChange thì chỉ cần 1 code
Thân
Nhấp chuột vào đây để mở rộng...

vâng em cám ơn. Em không biết có còn giải pháp nào không.
nói thật là em ngu dốt nếu các bác ko chỉ dạy cho thì cái đầu của em sẽ còn thắc mắc mãi.
em cám ơn rất nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
HieuCD đã viết:
làm cho bạn cả 3 cách
1/ dùng hàm Excel
2/ Dùng hàm tự tạo
2 cách trên bạn theo công thức trong file, đặt cột nào cũng được
3/ bấm vào biểu tượng chạy code
Nhấp chuột vào đây để mở rộng...
Bác ơi em bác có thể giúp em nếu như em nhập vào cột P các giá trị ngày tháng thì nó sẽ lấy giá trị ở Ô K4 điền vào cột M. em lấy code của bác em tùy chỉnh nhưng mà em ko làm dc. Mong các bác giúp em
Capture.jpg
 

File đính kèm

Upvote 0
concogia đã viết:
Copy ra nhiều Sheet thì phải giống nhau về địa chỉ rồi chép code vào sự kiện Workbook_SheetChange thì chỉ cần 1 code
Thân
Nhấp chuột vào đây để mở rộng...

Cách làm của lập trình là chép code vào 1 module (đặt tên module Common chẳng hạn). Lưu ý là sub/function phải là public

Các sự kiện của sheets sẽ gọi code này (thêm tiền tố Common/tên module vào).
VD: Common.HamCuaToi

Nếu dùng Workbook_SheetChange cũng nên gọi code chung bằng cách này.
 
Upvote 0
thufpts đã viết:
bác có thể làm cho nó auto lấy ngày khi có giá trị mà ko cần nhấn click vào biểu tưởng được không bác.
Nhấp chuột vào đây để mở rộng...
tuần qua bận việc nên không lên mạng.
bạn dùng code nầy, có thể thao tác một lần nhiều ô
khi cần chạy cho sheet mới, bạn copy code và dán vào sheet đó, nếu cầ thì chỉnh lại các tham số mình đã ghi chú trong code
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastC As Integer, i As Long, j As Integer, R As Long, C As Integer
Dim Darr(), Tarr(), Rng As Range, Ngay
Set Rng = Range("Q5")   'Q5 là ô ngày dau tien. Chinh lai dia chi Q5, neu can thiet
If Rng.Value = "" Then Exit Sub
R = Rng.Row: C = Rng.Column
If Target.Column >= C And Target.Row > R Then
    LastC = Rng.End(xlToRight).Column
    Tarr = Range(Rng, Cells(R, LastC)).Value
    For i = Target.Row To Target.Row + Target.Rows.Count - 1 Step 1
        Darr = Range(Cells(i, C), Cells(i, LastC)).Value
        Ngay = ""
        For j = LBound(Darr, 2) To UBound(Darr, 2) Step 1
            If Darr(1, j) > 0 Then
                Ngay = Tarr(1, j)
                Exit For
            End If
        Next j
        Cells(i, 14) = Ngay 'so 14 là thu tu cot N, là cot ket qua
    Next i
End If
Set Rng = Nothing
End Sub
 

File đính kèm

Upvote 0
HieuCD đã viết:
tuần qua bận việc nên không lên mạng.
bạn dùng code nầy, có thể thao tác một lần nhiều ô
khi cần chạy cho sheet mới, bạn copy code và dán vào sheet đó, nếu cầ thì chỉnh lại các tham số mình đã ghi chú trong code
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastC As Integer, i As Long, j As Integer, R As Long, C As Integer
Dim Darr(), Tarr(), Rng As Range, Ngay
Set Rng = Range("Q5")   'Q5 là ô ngày dau tien. Chinh lai dia chi Q5, neu can thiet
If Rng.Value = "" Then Exit Sub
R = Rng.Row: C = Rng.Column
If Target.Column >= C And Target.Row > R Then
    LastC = Rng.End(xlToRight).Column
    Tarr = Range(Rng, Cells(R, LastC)).Value
    For i = Target.Row To Target.Row + Target.Rows.Count - 1 Step 1
        Darr = Range(Cells(i, C), Cells(i, LastC)).Value
        Ngay = ""
        For j = LBound(Darr, 2) To UBound(Darr, 2) Step 1
            If Darr(1, j) > 0 Then
                Ngay = Tarr(1, j)
                Exit For
            End If
        Next j
        Cells(i, 14) = Ngay 'so 14 là thu tu cot N, là cot ket qua
    Next i
End If
Set Rng = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
cám ơn bác rất nhiều. cũng trong chiều nay em lần mò và tùy chỉnh được code của bác. thay vì phải copy code ra nhiều sheet em đã call được sub. cái này là nhờ có bác mà em học được. Nhưng còn vấn đề em đã trình bày ở trang 1 em lại không biết viết như thế nào để lấy 1 vị trí. mong bác giúp em.
 
Upvote 0
thufpts đã viết:
Bác ơi em bác có thể giúp em nếu như em nhập vào cột P các giá trị ngày tháng thì nó sẽ lấy giá trị ở Ô K4 điền vào cột M. em lấy code của bác em tùy chỉnh nhưng mà em ko làm dc. Mong các bác giúp em
Nhấp chuột vào đây để mở rộng...
code màu đỏ là mới thêm vào, còn lại là code của bạn
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count = 1 Then
            Call GPE
        End If
    End If
[COLOR=#ff0000]    If Not Intersect(Target, Range("$P$6:$P$1000")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]        If Target.Value <> "" Then[/COLOR]
[COLOR=#ff0000]            Cells(Target.Row, "M") = Range("K4").Value[/COLOR]
[COLOR=#ff0000]        Else[/COLOR]
[COLOR=#ff0000]            Cells(Target.Row, "M") = ""[/COLOR]
[COLOR=#ff0000]        End If[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
End Sub
 
Upvote 0
HieuCD đã viết:
code màu đỏ là mới thêm vào, còn lại là code của bạn
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count = 1 Then
            Call GPE
        End If
    End If
[COLOR=#ff0000]    If Not Intersect(Target, Range("$P$6:$P$1000")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]        If Target.Value <> "" Then[/COLOR]
[COLOR=#ff0000]            Cells(Target.Row, "M") = Range("K4").Value[/COLOR]
[COLOR=#ff0000]        Else[/COLOR]
[COLOR=#ff0000]            Cells(Target.Row, "M") = ""[/COLOR]
[COLOR=#ff0000]        End If[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
End Sub
Nhấp chuột vào đây để mở rộng...
hay thật chỉ với vài đường cơ bản của bác mà nó chạy ngon. nhưng khi em xóa 1 vài ô màu đỏ nó lại báo lỗi bác ạ. bác xem giúp em với
 
Lần chỉnh sửa cuối:
Upvote 0
thufpts đã viết:
hay thật chỉ với vài đường cơ bản của bác mà nó chạy ngon. nhưng khi em xóa 1 vài ô màu đỏ nó lại báo lỗi bác ạ. bác xem giúp em với
Nhấp chuột vào đây để mở rộng...
muốn xử nhiều ô thì dùng code sau
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count = 1 Then
            Call GPE
        End If
    End If
[COLOR=#ff0000]    If Not Intersect(Target, Range("$P$6:$P$1000")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]        For i = Target.Row To Target.Row + Target.Rows.Count - 1 Step 1[/COLOR]
[COLOR=#ff0000]            If Cells(i, "P").Value <> "" Then[/COLOR]
[COLOR=#ff0000]                Cells(i, "M") = Range("K4").Value[/COLOR]
[COLOR=#ff0000]            Else[/COLOR]
[COLOR=#ff0000]                Cells(i, "M") = ""[/COLOR]
[COLOR=#ff0000]            End If[/COLOR]
[COLOR=#ff0000]        Next i[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
End Sub
 
Upvote 0
HieuCD đã viết:
muốn xử nhiều ô thì dùng code sau
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count = 1 Then
            Call GPE
        End If
    End If
[COLOR=#ff0000]    If Not Intersect(Target, Range("$P$6:$P$1000")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]        For i = Target.Row To Target.Row + Target.Rows.Count - 1 Step 1[/COLOR]
[COLOR=#ff0000]            If Cells(i, "P").Value <> "" Then[/COLOR]
[COLOR=#ff0000]                Cells(i, "M") = Range("K4").Value[/COLOR]
[COLOR=#ff0000]            Else[/COLOR]
[COLOR=#ff0000]                Cells(i, "M") = ""[/COLOR]
[COLOR=#ff0000]            End If[/COLOR]
[COLOR=#ff0000]        Next i[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
End Sub
Nhấp chuột vào đây để mở rộng...
cám ơn bác. hết lỗi rồi bác ạ
 
Upvote 0
HieuCD đã viết:
muốn xử nhiều ô thì dùng code sau
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count = 1 Then
            Call GPE
        End If
    End If
[COLOR=#ff0000]    If Not Intersect(Target, Range("$P$6:$P$1000")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]        For i = Target.Row To Target.Row + Target.Rows.Count - 1 Step 1[/COLOR]
[COLOR=#ff0000]            If Cells(i, "P").Value <> "" Then[/COLOR]
[COLOR=#ff0000]                Cells(i, "M") = Range("K4").Value[/COLOR]
[COLOR=#ff0000]            Else[/COLOR]
[COLOR=#ff0000]                Cells(i, "M") = ""[/COLOR]
[COLOR=#ff0000]            End If[/COLOR]
[COLOR=#ff0000]        Next i[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
End Sub
Nhấp chuột vào đây để mở rộng...
bác ơi cho em hỏi chút em sửa code thành cột N khi em nhập số 48 vào ô Q6 nó chạy giật 1 lúc nó mới thôi. em không biết nó bị lỗi ở đâu nữa.
 

File đính kèm

Upvote 0
thufpts đã viết:
bác ơi cho em hỏi chút em sửa code thành cột N khi em nhập số 48 vào ô Q6 nó chạy giật 1 lúc nó mới thôi. em không biết nó bị lỗi ở đâu nữa.
Nhấp chuột vào đây để mở rộng...
bị đụng code
xóa hết code, thay bằng code mới
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count >= 1 Then
            Call GPE
        End If
    End If
End Sub
Mã: 
Sub GPE()
Dim Darr(), arr(1 To 1000, 1 To 2), tmp As String, i As Long, j As Integer
Darr = Range("Q5:AF1000").Value
tmp = Range("K4").Value
For i = 1 To 1000
    For j = 1 To UBound(Darr, 2)
        If Darr(i + 1, j) > 0 Then
            arr(i, 1) = tmp
            arr(i, 2) = Darr(1, j)
            Exit For
        End If
    Next j
    If arr(i, 1) = "" Then n = n + 1
    If n = 200 Then Exit For
Next i
Range("M6:N1000").ClearContents
Range("M6").Resize(i - 1, 2) = arr
End Sub
 
Upvote 0
HieuCD đã viết:
bị đụng code
xóa hết code, thay bằng code mới
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count >= 1 Then
            Call GPE
        End If
    End If
End Sub
Mã: 
Sub GPE()
Dim Darr(), arr(1 To 1000, 1 To 2), tmp As String, i As Long, j As Integer
Darr = Range("Q5:AF1000").Value
tmp = Range("K4").Value
For i = 1 To 1000
    For j = 1 To UBound(Darr, 2)
        If Darr(i + 1, j) > 0 Then
            arr(i, 1) = tmp
            arr(i, 2) = Darr(1, j)
            Exit For
        End If
    Next j
    If arr(i, 1) = "" Then n = n + 1
    If n = 200 Then Exit For
Next i
Range("M6:N1000").ClearContents
Range("M6").Resize(i - 1, 2) = arr
End Sub
Nhấp chuột vào đây để mở rộng...
chuẩn không cần chỉnh. cám ơn bác. chúc bác ngủ ngon
 
Upvote 0
HieuCD đã viết:
bị đụng code
xóa hết code, thay bằng code mới
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("$Q$6:$AF$1000"), Target) Is Nothing Then
        If Target.Count >= 1 Then
            Call GPE
        End If
    End If
End Sub
Mã: 
Sub GPE()
Dim Darr(), arr(1 To 1000, 1 To 2), tmp As String, i As Long, j As Integer
Darr = Range("Q5:AF1000").Value
tmp = Range("K4").Value
For i = 1 To 1000
    For j = 1 To UBound(Darr, 2)
        If Darr(i + 1, j) > 0 Then
            arr(i, 1) = tmp
            arr(i, 2) = Darr(1, j)
            Exit For
        End If
    Next j
    If arr(i, 1) = "" Then n = n + 1
    If n = 200 Then Exit For
Next i
Range("M6:N1000").ClearContents
Range("M6").Resize(i - 1, 2) = arr
End Sub
Nhấp chuột vào đây để mở rộng...
Bác có thể tùy chỉnh được code để khi em thay đổi code đặt ngày tháng và đặt vị trí được không. chẳng hạn em không muốn đặt 2 cột vị trí và ngày tháng gần nhau mà đặt vị trí tại cột L và ngày tháng tại cột N thì làm thế nào. mong bác giúp em
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

SA_DQ
[Xin hỏi] Cách tính số tiền bình quân của tài khoản trong 1 tháng (1 người xem)
Trả lời
10
Đọc
165
VetMini
V
A
  • Question Question
Nhờ anh chị em chú bác giúp em viết code vba thay cho công thức dò tìm và tính
Trả lời
2
Đọc
63
A HOANG 620
A
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
262
Đọc
28K
toptikibeauty
T
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
3
Đọc
135
minhminh27
minhminh27
nttrung_proneu
Cách giữ công thức khi lọc và tách file
Trả lời
2
Đọc
60
nttrung_proneu
nttrung_proneu
K
  • Question Question
Code vba đọc QR code file hình ảnh trên CCCD
    • Cười
Trả lời
0
Đọc
64
kingbo.camera
K
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024) (1 người xem)
    • Thích
2 3
Trả lời
42
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Gửi mail hàng loạt với mỗi mail là 1 file PDF đính kèm khác nhau
Trả lời
1
Đọc
56
minhminh27
minhminh27
B
Làm sao đổi đơn vị B, M này sang hàng đơn vị vậy mọi người?
    • Cười
Trả lời
4
Đọc
67
Bao Nguyen 89
B
C
Tạo hyperlink hàng loạt
Trả lời
9
Đọc
5K
online.tanphat
O
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
9
Đọc
7K
SA_DQ
SA_DQ
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
3
Đọc
91
dongbhhg
dongbhhg
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel (1 người xem)
Trả lời
12
Đọc
11K
Gà Công Nghệ
Gà Công Nghệ
N
Thử lập trình XLL add-in bằng C/C++
    • Thích
Trả lời
0
Đọc
91
nguyendang95
N
Tuấn Bụng Bự
tạo QRcode chuyển khoản ngân hàng
Trả lời
5
Đọc
224
Tuấn Bụng Bự
Tuấn Bụng Bự
M
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác.
Trả lời
1
Đọc
61
BuiQuangThuan
B
Quách Ngọc
Trả về kết quả ngày tháng hay khoảng trống (1 người xem)
Trả lời
3
Đọc
70
Quách Ngọc
Quách Ngọc
MaxanB
Cần hỗ trợ công thức Vlookup nhiều sheet theo điều kiên
Trả lời
2
Đọc
93
MaxanB
MaxanB
N
Không chạy được file VBA
Trả lời
3
Đọc
151
nhjngj
N
N
Xin giúp e cách lọc dữ liệu bị trùng
Trả lời
1
Đọc
77
hoangtuaotrang_hp_vn
H
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom