[Giúp] VBA insert cột và lọc dữ liệu có điều kiện (1 người xem)

[nguyetnga1992]

Xin chào cả nhà GPEX!

Xin cả nhà giúp em hoàn thành dự án bên dưới ạ... (Hơi rắc rối và lằng nhằng mong mọi người thông cảm..!).. trong File đính kèm em có làm bài mẫu.. có gì chỉ giáo em ạ..!

Mong cả nhà giúp đỡ...! Cảm ơn cả nhà nhiều ạ..

 

[Hoang2013]

Làm gì mà gởi file đến hơn 3M lên làm vậy!

 

[nguyetnga1992]

Làm gì mà gởi file đến hơn 3M lên làm vậy!

em sợ không đủ thông tin cả nhà sẽ k hiểu ý em ak...

 

[nguyetnga1992]

có ai giúp em không ạ!

 

[nguyetnga1992]

có cao thủ nào giúp em không ạ

 

[robinhsoon]

rắc rối nhỉ!..

 

[robinhsoon]

có cao thủ nào giúp em không ạ

Hiện tại mình làm được từ 1 đến 3 thôi và khai báo được hàm lấy ngày tháng, do trình độ VBA có hạn nên không thể giúp thêm được, cái vụ tích "X" gì đó thì bó tay, nên nhờ Pro khác ra tay nhé.. Mình cũng làm nhẹ bớt file của bạn lại rồi, để file nặng quá
'Hàm khai báo
Private Sub Input1_Click()
Dim strMonth As String
Dim lastIndex As Integer
Dim lastMonth As Integer
Dim i As Integer
lastIndex = 0
strMonth = TextBox1.Value
If strMonth = "" Then MsgBox "Vui long nhap du lieu...!": Exit Sub
For i = 1 To 6
Dim month As Integer
Dim year As Integer
Dim calMonth As Integer
month = Left(strMonth, Len(strMonth) - 4)
year = Right(strMonth, 4)
calMonth = month - i
If calMonth <= 0 Then
lastMonth = 12
calMonth = lastMonth - lastIndex
year = year - 1
lastIndex = lastIndex + 1
End If
Cells(i, 1) = calMonth & year
Next i
MsgBox ("OK")
UserForm1.Hide
End Sub

 

[nguyetnga1992]

Hiện tại mình làm được từ 1 đến 3 thôi và khai báo được hàm lấy ngày tháng, do trình độ VBA có hạn nên không thể giúp thêm được, cái vụ tích "X" gì đó thì bó tay, nên nhờ Pro khác ra tay nhé.. Mình cũng làm nhẹ bớt file của bạn lại rồi, để file nặng quá
'Hàm khai báo
Private Sub Input1_Click()
Dim strMonth As String
Dim lastIndex As Integer
Dim lastMonth As Integer
Dim i As Integer
lastIndex = 0
strMonth = TextBox1.Value
If strMonth = "" Then MsgBox "Vui long nhap du lieu...!": Exit Sub
For i = 1 To 6
Dim month As Integer
Dim year As Integer
Dim calMonth As Integer
month = Left(strMonth, Len(strMonth) - 4)
year = Right(strMonth, 4)
calMonth = month - i
If calMonth <= 0 Then
lastMonth = 12
calMonth = lastMonth - lastIndex
year = year - 1
lastIndex = lastIndex + 1
End If
Cells(i, 1) = calMonth & year
Next i
MsgBox ("OK")
UserForm1.Hide
End Sub

Cảm ơn anh đã quan tâm bài của em ạ...

Còn Bước 04 các Thầy giúp em với ạ.. Em đang cần gấp phần này ạ.... Em gửi lại File ạ
Mong các Thầy giúp đỡ... Em cảm ơn nhiều ạ.!

 

[quanluu]

Cảm ơn anh đã quan tâm bài của em ạ...

Còn Bước 04 các Thầy giúp em với ạ.. Em đang cần gấp phần này ạ.... Em gửi lại File ạ
Mong các Thầy giúp đỡ... Em cảm ơn nhiều ạ.!

Chắc là thế này:

Sub mark()
    Dim arr, darr, curmonth, curyear As Integer, month1, year1
    n = InputBox("nhap thang nam")
    curyear = Right(n, 4): curmonth = Left(n, Len(n) - 4)
    arr = Range("X2:Y" & Range("X65000").End(3).Row)
    ReDim darr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        year1 = Right(arr(i, 1), 4): month1 = Left(arr(i, 1), Len(arr(i, 1)) - 4)
        If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 7 And arr(i, 2) > 7 Then
            darr(i, 1) = "x"
        End If
        If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 4 And arr(i, 2) < 7 Then
            darr(i, 1) = "x"
        End If
    Next
    Range("V2").Resize(UBound(arr), 1) = darr
End Sub

 

[nguyetnga1992]

Chắc là thế này:

Sub mark()
    Dim arr, darr, curmonth, curyear As Integer, month1, year1
    n = InputBox("nhap thang nam")
    curyear = Right(n, 4): curmonth = Left(n, Len(n) - 4)
    arr = Range("X2:Y" & Range("X65000").End(3).Row)
    ReDim darr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        year1 = Right(arr(i, 1), 4): month1 = Left(arr(i, 1), Len(arr(i, 1)) - 4)
        If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 7 And arr(i, 2) > 7 Then
            darr(i, 1) = "x"
        End If
        If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 4 And arr(i, 2) < 7 Then
            darr(i, 1) = "x"
        End If
    Next
    Range("V2").Resize(UBound(arr), 1) = darr
End Sub

Cảm ơn Thầy đã giúp em ạ...!
Mới đầu thì chạy đúng ạ, nhưng khi em xóa 1 giá trị ở cột Timecode hoặc cột Status thì lại bị báo lỗi ạ..
Thầy giúp em phần này nhé....

 

[quanluu]

Cảm ơn Thầy đã giúp em ạ...!
Mới đầu thì chạy đúng ạ, nhưng khi em xóa 1 giá trị ở cột Timecode hoặc cột Status thì lại bị báo lỗi ạ..
Thầy giúp em phần này nhé....

Bạn gọi thầy mình thấy ngại quá, xét theo tuổi thì gọi anh, em cho tiện. Vấn đề của em thì thêm 1 dòng code điều kiện nữa thui.

Sub mark()
   Dim arr, darr, curmonth, curyear As Integer, month1, year1
   n = InputBox("nhap thang nam")
   curyear = Right(n, 4): curmonth = Left(n, Len(n) - 4)
   arr = Range("X2:Y" & Range("X65000").End(3).Row)
   ReDim darr(1 To UBound(arr), 1 To 1)
   For i = 1 To UBound(arr)
       if arr(i,1) <> "" and arr(i,2) <> "" then
       year1 = Right(arr(i, 1), 4): month1 = Left(arr(i, 1), Len(arr(i, 1)) - 4)
       If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 7 And arr(i, 2) > 7 Then
           darr(i, 1) = "x"
       End If
       If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 4 And arr(i, 2) < 7 Then
           darr(i, 1) = "x"
       End If
      End if
   Next
   Range("V2").Resize(UBound(arr), 1) = darr
End Sub

 

[nguyetnga1992]

Bạn gọi thầy mình thấy ngại quá, xét theo tuổi thì gọi anh, em cho tiện. Vấn đề của em thì thêm 1 dòng code điều kiện nữa thui.

Sub mark()
   Dim arr, darr, curmonth, curyear As Integer, month1, year1
   n = InputBox("nhap thang nam")
   curyear = Right(n, 4): curmonth = Left(n, Len(n) - 4)
   arr = Range("X2:Y" & Range("X65000").End(3).Row)
   ReDim darr(1 To UBound(arr), 1 To 1)
   For i = 1 To UBound(arr)
       if arr(i,1) <> "" and arr(i,2) <> "" then
       year1 = Right(arr(i, 1), 4): month1 = Left(arr(i, 1), Len(arr(i, 1)) - 4)
       If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 7 And arr(i, 2) > 7 Then
           darr(i, 1) = "x"
       End If
       If DateDiff("m", DateSerial(year1, month1, 1), DateSerial(curyear, curmonth, 1)) < 4 And arr(i, 2) < 7 Then
           darr(i, 1) = "x"
       End If
      End if
   Next
   Range("V2").Resize(UBound(arr), 1) = darr
End Sub

Hi Anh!
Xin lỗi vì hôm bửa giờ em bận quá không onl được, em cảm ơn anh đã giúp em đoạn code trên nhé và em cũng làm được rồi ạ...

Chúc Anh sức khoẻ và thành công ạ..!

 

[NguyetQue19992]

Xin chào cả nhà GPEX!

Xin cả nhà giúp em hoàn thành dự án bên dưới ạ... (Hơi rắc rối và lằng nhằng mong mọi người thông cảm..!).. trong File đính kèm em có làm bài mẫu.. có gì chỉ giáo em ạ..!
View attachment 176783
Mong cả nhà giúp đỡ...! Cảm ơn cả nhà nhiều ạ..

Chào bạn nguyetnga1992,
Bạn là ai tại sao lấy hình của mình làm ảnh đại diện?