'=========================================

'作者：大漠.jxzhoumin

'=========================================

Option?Base?1

Public?r?As?Integer

Public?row_gou()?As?Integer

Public?col_gou()?As?Integer

Public?gou_min_num?As?Double

'=================================================

Public?Function?tj(lb)?As?Integer

Dim?k?As?Integer

k?=?2

Do

Set?myR?=?Sheets(lb).Cells(k,?1)

If?Trim(myR.Value)?=?""Then?????'出現空記錄

Exit?Do

End?If

k?=?k?+?1

Loop?Until?False

tj?=?k?-?1

End?Function

'================================================

Private?Sub?CommandButton1_Click()

Application.ScreenUpdating?=?False

Call?findmin

Application.ScreenUpdating?=?True

Worksheets("sheet1").Activate

End?Sub

Sub?findmin()

Dim?num?As?Double,?min_num?As?Double

r?=?tj("原始數據")

Call?copy_data

With?Worksheets("sheet1")

For?i?=?2To?r

num?=?1000

For?j?=?2To?r

If?.Cells(i,?j).Value

min_num?=?.Cells(i,?j).Value

num?=?min_num?'獲得該行的最小數

End?If

Next?j

For?j?=?2To?r

.Cells(i,?j).Value?=?.Cells(i,?j).Value?-?min_num?'將每行減該行最小數

Next?j

Next?i

'======================================================================================

For?i?=?2To?r

num?=?1000

For?j?=?2To?r

If?.Cells(j,?i).Value

min_num?=?.Cells(j,?i).Value

num?=?min_num?'獲得該列的最小數

End?If

Next?j

For?j?=?2To?r

.Cells(j,?i).Value?=?.Cells(j,?i).Value?-?min_num?'將每列減該列最小數

Next?j

Next?i

End?With

Call?find_draw_zero

End?Sub

Function?find_draw_zero()

Dim?zero_row?As?Integer

zero_row?=?0

zero_row?=?findzero()

While?zero_row?>?0

Call?draw_zero(zero_row)

zero_row?=?findzero()

Wend

Call?bestvalue

End?Function

Function?findzero()?As?Integer

Dim?zero_num?As?Integer,?zero_row,?zero_col?As?Integer,?min_num?As?Integer

zero_num?=?0'行，列0元素的個數

min_num?=?1000

zero_row?=?0

zero_col?=?0

With?Worksheets("sheet1")

For?i?=?2To?r

zero_num?=?0

For?j?=?2To?r

If?.Cells(i,?j).Value?=?0Then

zero_num?=?zero_num?+?1

End?If

Next?j

If?zero_num?<>?0And?zero_num

min_num?=?zero_num

zero_row?=?i

End?If

Next?i

End?With

If?min_num?=?1000Then

zero_row?=?0

End?If

findzero?=?zero_row

End?Function

Sub?draw_zero(zero_row?As?Integer)

Dim?zero_col?As?Integer,?i?As?Integer

zero_col?=?find_col_num(zero_row)

With?Worksheets("sheet1")

.Cells(zero_row,?zero_col).Value?=?"@"'將對應的0劃成@

For?i?=?2To?r

If?.Cells(zero_row,?i).Value?=?0Then

.Cells(zero_row,?i).Value?=?"*"'找到對應的行的0劃成*

End?If

Next?i

For?i?=?2To?r

If?.Cells(i,?zero_col).Value?=?0Then

.Cells(i,?zero_col).Value?=?"*"'找到對應的列的0劃成*

End?If

Next?i

End?With

End?Sub

Function?find_col_num(zero_row?As?Integer)?As?Integer

Dim?count?As?Integer,?col_num?As?Integer,?min_count?As?Integer

min_count?=?1000

With?Worksheets("sheet1")

For?i?=?2To?r

If?.Cells(zero_row,?i).Value?=?0Then

count?=?0

For?j?=?2To?r

If?.Cells(j,?i).Value?=?0Or?.Cells(j,?i).Value?="*"Then

count?=?count?+?1

End?If

Next?j

If?count

min_count?=?count

find_col_num?=?i?'找到需要標記的0列的數值，該0的列的0的個數最少

End?If

End?If

Next?i

End?With

End?Function

Function?bestvalue()?As?Boolean

Dim?count?As?Integer

count?=?0

With?Worksheets("sheet1")

For?i?=?2To?r

For?j?=?2To?r

If?.Cells(i,?j).Value?=?"@"Then

count?=?count?+?1

End?If

Next?j

Next?i

End?With

If?count?=?r?-?1Then

bestvalue?=?True

Call?show_infor

MsgBox?"達到最優解！"

Else

bestvalue?=?False

Call?draw_gou

Call?find_gou_min_num

Call?row_gou_jian

Call?col_gou_jia

Call?init_second

End?If

End?Function

Sub?draw_gou()

Dim?i?As?Integer,?count?As?Integer

Dim?row_num,?col_num?As?Integer

i?=?1

Erase?row_gou

Erase?col_gou

ReDim?row_gou(1)

ReDim?col_gou(1)

With?Worksheets("sheet1")

For?i?=?2To?r

count?=?0

For?j?=?2To?r

If?.Cells(i,?j).Value?=?"@"Then

count?=?count?+?1

End?If

Next?j

If?count?=?0Then

row_num?=?i

If?row_gou(0)?=0Then

row_u?=?0

Else

row_u?=?UBound(row_gou)

End?If

If?col_gou(0)?=0Then

col_u?=?0

Else

col_u?=?UBound(col_gou)

End?If

For?j?=?2To?r

If?.Cells(row_num,?j).Value?=?"*"Then

col_num?=?j

End?If

Next?j

If?chongfu_row(row_num)?Then

ReDim?Preserve?row_gou(row_u?+?1)

row_gou(row_u?+?1)?=?row_num??'將行畫鉤的序列值做標記

End?If

If?chongfu_col(col_num)?Then

ReDim?Preserve?col_gou(col_u?+?1)

col_gou(col_u?+?1)?=?col_num??'將列畫鉤的序列值做標記

Call?col_to_row(col_num)

End?If

End?If

Next?i

End?With

End?Sub

Function?chongfu_row(ByVal?row_num?As?Integer)?As?Boolean

row_u?=?UBound(row_gou)

chongfu_row?=?True

For?i?=?1To?row_u

If?row_gou(i)?=?row_num?Then

chongfu_row?=?False

End?If

Next?i

End?Function

Function?chongfu_col(ByVal?col_num?As?Integer)?As?Boolean

col_u?=?UBound(col_gou)

chongfu_col?=?True

For?i?=?1To?col_u

If?col_gou(i)?=?col_num?Then

chongfu_col?=?False

End?If

Next?i

End?Function

Sub?col_to_row(ByVal?col_num?As?Integer)

row_u?=?UBound(row_gou)

col_u?=?UBound(col_gou)

row_num?=?0

With?Worksheets("sheet1")

For?i?=?2To?r

If?.Cells(i,?col_num).Value?=?"@"Then

row_num?=?i

If?chongfu_row(row_num)?Then

ReDim?Preserve?row_gou(row_u?+?1)

row_gou(row_u?+?1)?=?row_num??'將行畫鉤的序列值做標記

End?If

For?j?=?2To?r

If?.Cells(row_num,?i).Value?=?"*"Then

If?chongfu_col(col_num)?Then

ReDim?Preserve?col_gou(col_u?+?1)

col_gou(col_u?+?1)?=?i?'將列畫鉤的序列值做標記

'Call?col_to_row(i)?'全套循環函數得出畫鉤的行

End?If

End?If

Next?j

End?If

Next?i

End?With

End?Sub

Sub?find_gou_min_num()

Dim?row_u?As?Integer,?row_num?As?Integer,?min_num?As?Double

min_num?=?1000

row_u?=?UBound(row_gou)

With?Worksheets("sheet1")

For?i?=?1To?row_u

For?j?=?2To?r

row_num?=?row_gou(i)

If?.Cells(row_num,?j).Value?<>?"*"And?.Cells(row_num,?j).Value?<>"@"Then

If?.Cells(row_num,?j).Value

min_num?=?.Cells(row_num,?j).Value

gou_min_num?=?min_num

End?If

End?If

Next?j

Next?i

End?With

End?Sub

Sub?row_gou_jian()

Dim?row_u?As?Integer,?row_num?As?Integer

row_u?=?UBound(row_gou)

With?Worksheets("sheet1")

For?i?=?1To?row_u

For?j?=?2To?r

row_num?=?row_gou(i)

If?.Cells(row_num,?j).Value?<>?"*"And?.Cells(row_num,?j).Value?<>"@"Then

.Cells(row_num,?j).Value?=?.Cells(row_num,?j)?-?gou_min_num?'將畫鉤的行的數減去最小數

End?If

Next?j

Next?i

End?With

End?Sub

Sub?col_gou_jia()

Dim?col_u?As?Integer,?col_num?As?Integer

col_u?=?UBound(col_gou)

With?Worksheets("sheet1")

For?i?=?1To?col_u

col_num?=?col_gou(i)

For?j?=?2To?r

If?.Cells(j,?col_num).Value?<>?"*"And?.Cells(j,?col_num).Value?<>"@"Then

.Cells(j,?col_num).Value?=?Val(Trim(.Cells(j,?col_num).Value))?+?gou_min_num?'將畫鉤的行的數減去最小數

End?If

Next?j

Next?i

End?With

End?Sub

Sub?init_second()

With?Worksheets("sheet1")

For?i?=?2To?r

For?j?=?2To?r

If?.Cells(i,?j).Value?=?"@"Or?.Cells(i,?j).Value?="*"Then

.Cells(i,?j).Value?=?0

End?If

Next?j

Next?i

End?With

Call?find_draw_zero

End?Sub

Sub?show_infor()

With?Worksheets("sheet1")

For?i?=?2To?r

For?j?=?2To?r

If?.Cells(i,?j).Value?=?"@"Then

.Cells(i,?j).Value?=?1

Else:?.Cells(i,?j).Value?=?0

End?If

Next?j

Next?i

End?With

End?Sub

Sub?copy_data()

For?i?=?1To?r

For?j?=?1To?r

With?Worksheets("原始數據")

num?=?.Cells(i,?j).Value

End?With

With?Worksheets("sheet1")

.Cells(i,?j).Value?=?num

End?With

Next?j

Next?i

End?Sub

總結

以上是生活随笔為你收集整理的Java指派问题_指派问题的匈牙利算法的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。