Cột bị mất công thức khi tham chiếu mảng

[hadoan-pap]

Kính gửi mọi người.

Em có 1 bài toàn như file đính kèm. SD1 và SD2 ở Sheet2 dc tham chiếu từ Sheet1 sang.

Nhưng khi tham chiếu sang thì e k hiểu sao cột " Total " ỏ Sheet2 bị mất hết công thức... e đang để cột đó có công thức " Sum " như trong file. Nhưng khi tham chiếu chạy lệnh như bên dưới thì cột đó bị mất công thức.

Mọi người xem và cho em biết cách sửa để cột " Total " không bị mất công thức với ạ.

E xin cảm ơn!

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
For i = 1 To UBound(arr1, 1)
'If arr1(i, 1) <> Empty Then
For j = 1 To UBound(arr, 1)
If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
arr1(i, 4) = arr(j, 2)
arr1(i, 6) = arr(j, 3)
End If
Next j
'End If
Next i
Sheet2.Range("b2").Resize(UBound(arr1, 1), 6).Value = arr1 'gán giá tri tu mang vao sheet2
End Sub

 

[snow25]

Kính gửi mọi người.

Em có 1 bài toàn như file đính kèm. SD1 và SD2 ở Sheet2 dc tham chiếu từ Sheet1 sang.

Nhưng khi tham chiếu sang thì e k hiểu sao cột " Total " ỏ Sheet2 bị mất hết công thức... e đang để cột đó có công thức " Sum " như trong file. Nhưng khi tham chiếu chạy lệnh như bên dưới thì cột đó bị mất công thức.

Mọi người xem và cho em biết cách sửa để cột " Total " không bị mất công thức với ạ.

E xin cảm ơn!

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
For i = 1 To UBound(arr1, 1)
'If arr1(i, 1) <> Empty Then
For j = 1 To UBound(arr, 1)
If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
arr1(i, 4) = arr(j, 2)
arr1(i, 6) = arr(j, 3)
End If
Next j
'End If
Next i
Sheet2.Range("b2").Resize(UBound(arr1, 1), 6).Value = arr1 'gán giá tri tu mang vao sheet2
End Sub

bạn gán theo kiểu này nó sẽ chỉ gán giá trị thôi chứ không gán công thức nhé bạn.
và nó cũng xóa luôn ct của bạn

 

[hadoan-pap]

bạn gán theo kiểu này nó sẽ chỉ gán giá trị thôi chứ không gán công thức nhé bạn.
và nó cũng xóa luôn ct của bạn

Dear anh,

Có cách nào để các cột trc đó k bị mất công thức k anh?

E áp dung đc hướng dẫn code của anh trên file của em rồi, nhưng khi chạy thì các cột trong mảng đó mất hết công thức anh ạ.

Ý e là cột nào cần gán giá trị thì mình tham chiếu, còn cột nào k liên quan thì giữ nguyên công thức của nó ạ.

 

[snow25]

Dear anh,

Có cách nào để các cột trc đó k bị mất công thức k anh?

E áp dung đc hướng dẫn code của anh trên file của em rồi, nhưng khi chạy thì các cột trong mảng đó mất hết công thức anh ạ.

Ý e là cột nào cần gán giá trị thì mình tham chiếu, còn cột nào k liên quan thì giữ nguyên công thức của nó ạ.

em thay code trên bằng đoạn code này nhé

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 3)
For i = 1 To UBound(arr1, 1)
    'If arr1(i, 1) <> Empty Then
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr2(i, 3) = arr(j, 3)
           End If
      Next j
    'End If
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 3).Value = arr2   'gán giá tri tu mang vao sheet2
End Sub

 

[hadoan-pap]

em thay code trên bằng đoạn code này nhé

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 3)
For i = 1 To UBound(arr1, 1)
    'If arr1(i, 1) <> Empty Then
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr2(i, 3) = arr(j, 3)
           End If
      Next j
    'End If
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 3).Value = arr2   'gán giá tri tu mang vao sheet2
End Sub

Dear anh

Cảm ơn anh nhé. Xin lỗi anh vì giờ e mới ngồi máy tính đc.

Anh cho em hỏi là code anh gửi thì dòng lệnh nào xử lý đc việc k làm mất công thức các cột ạ ?

Anh vui long giải thích 1 chút giúp em đoạn đó nhé.

E cảm ơn anh!

 

[snow25]

Dear anh

Cảm ơn anh nhé. Xin lỗi anh vì giờ e mới ngồi máy tính đc.

Anh cho em hỏi là code anh gửi thì dòng lệnh nào xử lý đc việc k làm mất công thức các cột ạ ?

Anh vui long giải thích 1 chút giúp em đoạn đó nhé.

E cảm ơn anh!

em cứ dùng vào đi tại vì anh dùng thêm mảng mới gán nó không vào cột công thức nữa chứ code nó vẫn thế mà

 

[hadoan-pap]

em cứ dùng vào đi tại vì anh dùng thêm mảng mới gán nó không vào cột công thức nữa chứ code nó vẫn thế mà

Dear anh,

Anh ơi lệnh này ý nghĩa là gì anh nhỉ ?

ReDim arr2(1 To UBound(arr1, 1), 1 To 3)

 

[snow25]

Dear anh,

Anh ơi lệnh này ý nghĩa là gì anh nhỉ ?

ReDim arr2(1 To UBound(arr1, 1), 1 To 3)

khai báo mảng bạn à.đây là mình khai báo để sử dụng mảng đấy

 

[hadoan-pap]

khai báo mảng bạn à.đây là mình khai báo để sử dụng mảng đấy

Dear anh,

Nếu ở sheet2, giữa cột SD1 và SD2 mà có 1 cột khác cũng có công thức thì phải sửa Code như nào để gán giá trị vào cột SD2 mà k làm mất công thức ở các cột trong khoảng giữa SD1,SD2 ạ ?

Em đang chỉnh sửa từ code anh gửi làm đc cái k mất công thức nhưng gán giá trị thì chưa đc trong khoảng các cột từ SD1 đến SD2 ạ

 

[snow25]

Dear anh,

Nếu ở sheet2, giữa cột SD1 và SD2 mà có 1 cột khác cũng có công thức thì phải sửa Code như nào để gán giá trị vào cột SD2 mà k làm mất công thức ở các cột trong khoảng giữa SD1,SD2 ạ ?

Em đang chỉnh sửa từ code anh gửi làm đc cái k mất công thức nhưng gán giá trị thì chưa đc trong khoảng các cột từ SD1 đến SD2 ạ

chắc là phải tách cái mảng đấy ra thôi chứ tại vì khi gán vào nó sẽ bị mất hết giá trị.

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 1)
ReDim arr3(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr3(i, 1) = arr(j, 3)
           End If
      Next j
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 1).Value = arr2   'gán giá tri tu mang vao sheet2
Sheet2.Range("g2").Resize(UBound(arr1, 1), 1).Value = arr3
End Sub

 

[hadoan-pap]

chắc là phải tách cái mảng đấy ra thôi chứ tại vì khi gán vào nó sẽ bị mất hết giá trị.

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 1)
ReDim arr3(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr3(i, 1) = arr(j, 3)
           End If
      Next j
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 1).Value = arr2   'gán giá tri tu mang vao sheet2
Sheet2.Range("g2").Resize(UBound(arr1, 1), 1).Value = arr3
End Sub

Dear anh,

E cảm ơn a nhé. E lúc đầu sửa mãi k dc hóa ra là bị sai ở cái Redim khai báo chưa đúng ạ

E cũng tách ra như anh nhưng cái Redim của em vẫn y như cái cũ chứ k sửa lại như anh nên mãi k chạy dc

 

[snow25]

Dear anh,

E cảm ơn a nhé. E lúc đầu sửa mãi k dc hóa ra là bị sai ở cái Redim khai báo chưa đúng ạ

E cũng tách ra như anh nhưng cái Redim của em vẫn y như cái cũ chứ k sửa lại như anh nên mãi k chạy dc

uh nhưng do bạn lúc gán cũng lấy luôn cả mảng đấy gán vào nên nó bị xóa đấy.cái chỗ mà chon RISEZE ấy.

 

[hadoan-pap]

uh nhưng do bạn lúc gán cũng lấy luôn cả mảng đấy gán vào nên nó bị xóa đấy.cái chỗ mà chon RISEZE ấy.

Dear anh,

anh ơi phát sinh them 1 issue ạ... Các Item thuộc cột SD1, SD2 ở Sheet2 thì hang cuối cùng của nó là Total cũng bị mất công thức anh ạ.

Vậy mình sửa code như thế nào để k bị mất công thức ở dòng cuối cùng Total a nhỉ ? Mình có thể check điều kiện ở Sheet1 nếu các hang ở cột 1 mà rỗng thì k tham chiếu đc k anh?

Anh check giúp em với nhé. Hàng cuối cùng của em có nh công thức Total và mấy công thức khác cũng bị mất khi tham chiếu anh ạ.

 

[snow25]

Dear anh,

anh ơi phát sinh them 1 issue ạ... Các Item thuộc cột SD1, SD2 ở Sheet2 thì hang cuối cùng của nó là Total cũng bị mất công thức anh ạ.

Vậy mình sửa code như thế nào để k bị mất công thức ở dòng cuối cùng Total a nhỉ ? Mình có thể check điều kiện ở Sheet1 nếu các hang ở cột 1 mà rỗng thì k tham chiếu đc k anh?

Anh check giúp em với nhé. Hàng cuối cùng của em có nh công thức Total và mấy công thức khác cũng bị mất khi tham chiếu anh ạ.

Sub Button1_Click()

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row - 1).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 1)
ReDim arr3(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr3(i, 1) = arr(j, 3)
           End If
      Next j
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 1).Value = arr2   'gán giá tri tu mang vao sheet2
Sheet2.Range("g2").Resize(UBound(arr1, 1), 1).Value = arr3
End Sub

đây em nhé,em gửi dữ liệu cho anh thì mới biết chứ gửi ví dụ cụ thể đi anh làm cho luôn nó gọn.

 

[hadoan-pap]

Sub Button1_Click()

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row - 1).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 1)
ReDim arr3(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr3(i, 1) = arr(j, 3)
           End If
      Next j
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 1).Value = arr2   'gán giá tri tu mang vao sheet2
Sheet2.Range("g2").Resize(UBound(arr1, 1), 1).Value = arr3
End Sub

đây em nhé,em gửi dữ liệu cho anh thì mới biết chứ gửi ví dụ cụ thể đi anh làm cho luôn nó gọn.

Dear anh,

Cảm ơn anh nhé

Để e thử với file của em ạ. File của em nó nh dữ lieu confidential và nó nặng lắm ạ nên cũng khó đưa lên ạ.

 

[hadoan-pap]

Sub Button1_Click()

Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long
arr = Sheet1.Range("A1:c" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value 'lây giá tri vao mang
arr1 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row - 1).Value 'lây giá tri vao mang
ReDim arr2(1 To UBound(arr1, 1), 1 To 1)
ReDim arr3(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
       For j = 1 To UBound(arr, 1)
           If UCase(arr1(i, 1)) = UCase(arr(j, 1)) Then
           arr2(i, 1) = arr(j, 2)
           arr3(i, 1) = arr(j, 3)
           End If
      Next j
Next i
Sheet2.Range("e2").Resize(UBound(arr1, 1), 1).Value = arr2   'gán giá tri tu mang vao sheet2
Sheet2.Range("g2").Resize(UBound(arr1, 1), 1).Value = arr3
End Sub

đây em nhé,em gửi dữ liệu cho anh thì mới biết chứ gửi ví dụ cụ thể đi anh làm cho luôn nó gọn.

Dear anh,

Anh ơi bài toán trc e đã áp dung đc cho 1 case bên em rồi ạ ... E cảm ơn anh rất nh.

Giờ có 1 bài toán nhỏ khác e muốn nhờ a chút xíu để học hỏi sample ạ.

File em gửi Sheet5 sẽ đc tham chiếu từ Sheet4 như sau .

- Nó căn cứ theo " Mã " để tham chiếu giá trị sang
- Ở sheet4 thì cột "B" dòng có chữ " Total" sẽ thay đổi liên tục k cố định như hiện tại ở ô B7.... Mình sẽ cho biến chạy hết cột B từ trên xuống dưới, Cột B dòng nào mà có chữ " Total " thì nó căn cứ để tham chiếu giá trị đó sang Sheet5.

Em đang loay hoay k hiểu cho biến chạy ntn để làm dc việc này.

Anh cho e xin đoạn code tham khảo với a nhé.

E xl lại làm phiền anh. E cảm ơn anh ạ!

 

[snow25]

Dear anh,

Anh ơi bài toán trc e đã áp dung đc cho 1 case bên em rồi ạ ... E cảm ơn anh rất nh.

Giờ có 1 bài toán nhỏ khác e muốn nhờ a chút xíu để học hỏi sample ạ.

File em gửi Sheet5 sẽ đc tham chiếu từ Sheet4 như sau .

- Nó căn cứ theo " Mã " để tham chiếu giá trị sang
- Ở sheet4 thì cột "B" dòng có chữ " Total" sẽ thay đổi liên tục k cố định như hiện tại ở ô B7.... Mình sẽ cho biến chạy hết cột B từ trên xuống dưới, Cột B dòng nào mà có chữ " Total " thì nó căn cứ để tham chiếu giá trị đó sang Sheet5.

Em đang loay hoay k hiểu cho biến chạy ntn để làm dc việc này.

Anh cho e xin đoạn code tham khảo với a nhé.

E xl lại làm phiền anh. E cảm ơn anh ạ!

Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long, i As Long, j As Long, k As Long
With Sheets("sheet4")
arr = .Range("b3:m" & .Range("b" & Rows.Count).End(xlUp).Row).Value
arr1 = Sheets("Sheet5").Range("C4:q5").Value
    For i = UBound(arr, 1) To 2 Step -1
       If UCase(arr(i, 1)) = UCase("Total") Then
          For j = 2 To UBound(arr1, 2)
              For k = 2 To UBound(arr, 2)
             If UCase(arr(1, k)) = UCase(arr1(1, j)) Then
                 arr1(2, j) = arr(i, k)
             End If
            Next k
          Next j
          Exit For
       End If
    Next i
End With
  Sheets("Sheet5").Range("c4").Resize(2, UBound(arr1, 2)).Value = arr1
End Sub

đây bạn xem đi

 

[hadoan-pap]

Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long, i As Long, j As Long, k As Long
With Sheets("sheet4")
arr = .Range("b3:m" & .Range("b" & Rows.Count).End(xlUp).Row).Value
arr1 = Sheets("Sheet5").Range("C4:q5").Value
    For i = UBound(arr, 1) To 2 Step -1
       If UCase(arr(i, 1)) = UCase("Total") Then
          For j = 2 To UBound(arr1, 2)
              For k = 2 To UBound(arr, 2)
             If UCase(arr(1, k)) = UCase(arr1(1, j)) Then
                 arr1(2, j) = arr(i, k)
             End If
            Next k
          Next j
          Exit For
       End If
    Next i
End With
  Sheets("Sheet5").Range("c4").Resize(2, UBound(arr1, 2)).Value = arr1
End Sub

đây bạn xem đi

Dear anh,

E cảm ơn anh ^^

Nhưng trong code e chạy thì ở Sheet5 những cột ở giữa k có data bị mất công thức như lần trc anh ạ.

Mình sửa lại tnao a nhỉ ?

 

[snow25]

Dear anh,

E cảm ơn anh ^^

Nhưng trong code e chạy thì ở Sheet5 những cột ở giữa k có data bị mất công thức như lần trc anh ạ.

Mình sửa lại tnao a nhỉ ?

đây nhé bạn mình bằng tuổi bạn thôi hi

Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long, i As Long, j As Long, k As Long
With Sheets("sheet4")
arr = .Range("b3:m" & .Range("b" & Rows.Count).End(xlUp).Row).Value
    For i = UBound(arr, 1) To 2 Step -1
       If UCase(arr(i, 1)) = UCase("Total") Then
          For j = 4 To 17
             For k = 2 To UBound(arr, 2)
             If UCase(arr(1, k)) = UCase(Cells(4, j)) Then
                 Sheets("sheet5").Cells(5, j).Value = arr(i, k)
             End If
            Next k
          Next j
          Exit For
       End If
    Next i
End With
End Sub

 

[hadoan-pap]

đây nhé bạn mình bằng tuổi bạn thôi hi

Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long, i As Long, j As Long, k As Long
With Sheets("sheet4")
arr = .Range("b3:m" & .Range("b" & Rows.Count).End(xlUp).Row).Value
    For i = UBound(arr, 1) To 2 Step -1
       If UCase(arr(i, 1)) = UCase("Total") Then
          For j = 4 To 17
             For k = 2 To UBound(arr, 2)
             If UCase(arr(1, k)) = UCase(Cells(4, j)) Then
                 Sheets("sheet5").Cells(5, j).Value = arr(i, k)
             End If
            Next k
          Next j
          Exit For
       End If
    Next i
End With
End Sub

Đa tạ đa tạ ^^

Bài đã được tự động gộp: 6/11/18

đây nhé bạn mình bằng tuổi bạn thôi hi

Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long, i As Long, j As Long, k As Long
With Sheets("sheet4")
arr = .Range("b3:m" & .Range("b" & Rows.Count).End(xlUp).Row).Value
    For i = UBound(arr, 1) To 2 Step -1
       If UCase(arr(i, 1)) = UCase("Total") Then
          For j = 4 To 17
             For k = 2 To UBound(arr, 2)
             If UCase(arr(1, k)) = UCase(Cells(4, j)) Then
                 Sheets("sheet5").Cells(5, j).Value = arr(i, k)
             End If
            Next k
          Next j
          Exit For
       End If
    Next i
End With
End Sub

Dear ^^

Bạn có thể vui long giải thích giúp mình đoạn code bên dưới đc k? chỉ cần giải thích vòng For vì that sự mình chưa hiểu vòng For đó khai báo chạy ntn. Hiện mình đã áp dung đc vào job của mình rồi nhưng vẫn chưa hiểu vòng For khai báo ntn

For i = UBound(arr, 1) To 2 Step -1 ==>> Chỗ này mình k hiểu
If UCase(arr(i, 1)) = UCase("Total") Then
For j = 4 To 17
For k = 2 To UBound(arr, 2) ==>> Chỗ này mình k hiểu
If UCase(arr(1, k)) = UCase(Cells(4, j)) Then
Sheets("sheet5").Cells(5, j).Value = arr(i, k)
End If
Next k
Next j
Exit For
End If
Next i